Macro with input box to Select a column on active sheet

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Marcusdmc - 19 Sep 2007 14:06 GMT

I am trying to take information that is on a worksheet who's name
stays constant that gets updated daily from another one and then paste
that information into another worksheet. The layout would be

constantworksheet(data):

A1 B1 C1 D1
Name Jobtype1 Jobtype2 Jobtype3
Jdoe 5 21 6
Rdoe 8 18 7
and paste into a monthly worksheet

A1 B1 C1 D1
Name Day1 Day2 Day3 ....
Jdoe
Jobtype1 5
Jobtype2 21
Jobtype3 6
Totals sum
Rdoe
Jobtype1 5
Jobtype2 18
Jobtype3 7

how would I get a macro automatically pull over the information?
Would I do a lookup on the name of the activesheet to the datasheet,
select which column i want, then use offset 0,1 to move down a column
and use an input box to select which day(column) they want to paste
information in for each person? Any direction would be appreciated!

-Marcus

Reply to this Message

Tom Ogilvy - 19 Sep 2007 14:38 GMT

It is unclear exactly what you want, but perhaps there is something here you
can use.

dim r as Range, r1 as Range
On error resume Next
set r = Application.InputBox("Select cell to paste to with mouse", type:=8)
set r1 = Application.InputBox("Select cells to copy with mouse", type:=8)
On error goto 0
if r is nothing or r1 is nothing then exit sub
r1.copy
r.PasteSpecial xlPasteAll, transpose = True

For completeness
There is a bug in the use of this function if your sheet contains
conditional formatting using the Formula Is dropdown:

http://www.jkp-ads.com/Articles/SelectARange.asp

Hopefully that won't affect you.

Signature

Regards,
Tom Ogilvy

> I am trying to take information that is on a worksheet who's name
> stays constant that gets updated daily from another one and then paste
[quoted text clipped - 27 lines]
>
> -Marcus

Reply to this Message

Marcusdmc - 19 Sep 2007 14:51 GMT

Thank you for the response! That would work for sure, but I'm looking
for a more automated way to copy type 1 on datasheet which is arranged
vertically and paste in job type 1 on monthsheet which is arranged
horizontally.

-Marcus

Reply to this Message

Marcusdmc - 19 Sep 2007 14:54 GMT

The input box would be to determine which date(column) you wanted to
paste into for each person on the monthly sheet

Reply to this Message

Tom Ogilvy - 19 Sep 2007 15:58 GMT

Here is some untested pseudo code:

Dim r as Range, r1 as Range
Dim r2 as Range, cell as Range
Dim res as Variant
On error resume Next
set r = Nothing
set r = Application.InputBox( _
"Select destination column in Summary",type:=8)
On Error goto 0
if r is nothing then exit sub

with worksheets("Daily")
set r1 = .Range(.Cells(2,1),.Cells(2,1).end(xldown))
end with
with worksheets("Summary")
set r2 = .Range(.Cells(2,1),.Cells(2,1).End(xldown))
End with
for each cell in r1
res = Application.Match(cell,r2,0)
if not iserror(res) then
set r3 = r2(res)
cell.offset(0,1).Resize(1,3).copy
r3.offset(1,r.column-1).Pastespecial Transpose:=True
end if
Next

Signature

Regards,
Tom Ogilvy

> The input box would be to determine which date(column) you wanted to
> paste into for each person on the monthly sheet

Reply to this Message

Marcusdmc - 25 Sep 2007 18:53 GMT

Trying to make it so that instead of naming the worksheet "summary",
they can just be on the worksheet they want to modify with the
information from the "daily" page. trying this but it's not working,
getting a type mismatch on the with works

Sub TestMe()
Dim mSheet As Worksheet
Set mSheet = ActiveSheet

Dim sr As Range, sr1 As Range
Dim sr2 As Range, cell As Range
Dim res As Variant
On Error Resume Next
Set sr = Nothing
Set sr = Application.InputBox( _
"Select Weekly Column to update", Type:=8)
On Error GoTo 0
If sr Is Nothing Then Exit Sub

With Worksheets(mSheet)
Set sr1 = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With
With Worksheets(mSheet)
Set sr2 = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With
For Each cell In sr1
res = Application.Match(cell, r2, 0)
If Not IsError(res) Then
Set sr3 = sr2(res)
cell.Offset(0, 1).Resize(1, 3).Copy
r3.Offset(1, r.Column - 1).PasteSpecial Transpose:=True
End If
Next

End Sub

-Marcus

Reply to this Message

Marcusdmc - 25 Sep 2007 19:53 GMT

Actually I figured out the answer!!! :)

Reply to this Message