Looping through rows and columns

byrdamy

New Member
Joined
Jun 29, 2007
Messages
15
I am fairly new to VBA, but I can normally worm my way through. I am stumped here. Any help is greatly appreciated.

I have a report in sheet "day" that in column H1:Q1 I have employee names, in H2:Q Finalrow I have hours worked, in column D2-G Finalrow I have a list of information they worked on.

I need to loop through each column(H-Q) by row and copy into a separate sheet called "input" to create a database to pivot.

I need it to take the employees name from "day" and put in column E in the "input" sheet, then take the hours worked from "Day" column H and put in Column F in the "input" sheet, then take the information in column D-G in the "day" sheet and copy in column A-D on the "input" sheet, and go through each row in and each column. It is basically re-arranging the sheet "day".

I got it to do one column, but couldn't make it copy to next available row on "Input" sheet, it kept overwriting the same 1st row.

This is what I have, I had it only copying if hours worked were more than 0:

Sub test()
finalrow = Range("f65536").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 9).Value > 0 Then
Cells(1, 9).Copy
Worksheets("input").Activate
finalrow1 = Range("e65536").End(xlUp).Row
Range("e" & finalrow1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("day").Activate
Cells(i, "d").Resize(, 4).Copy
Worksheets("input").Activate
finalrow2 = Range("a65536").End(xlUp).Row
Range("a" & finalrow2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("day").Activate
End If
Next i
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Code:
Sub blah()
Set DSht = Sheets("Input")
DestRow = DSht.Cells(DSht.Rows.Count, "A").End(xlUp).Row + 1
With Sheets("Day")
  Finalrow = .Range("f65536").End(xlUp).Row
  For Each cll In .Range("H2:Q" & Finalrow)
    If cll.Value > 0 Then
      cll.Copy DSht.Cells(DestRow, "F")
      .Cells(cll.Row, "D").Resize(, 4).Copy DSht.Cells(DestRow, "A")
      .Cells(1, cll.Column).Copy DSht.Cells(DestRow, "E")
      DestRow = DestRow + 1
    End If
  Next cll
End With
End Sub
edit: I've just noticed your code use xlPasteValues, where above I straight copied. If this is a problem, come back and I'll tweak.
 
Upvote 0
I just tested and this is perfect, I do need the pastevalues because it is a formula being copied into text.

Thanks. Out of curiousity, what was I doing wrong?
 
Upvote 0
I just tested and this is perfect, I do need the pastevalues because it is a formula being copied into text.

Thanks. Out of curiousity, what was I doing wrong?
Code:
Sub blahcc()
Set DSht = Sheets("Input")
DestRow = DSht.Cells(DSht.Rows.Count, "A").End(xlUp).Row + 1
With Sheets("Day")
  Finalrow = .Range("f65536").End(xlUp).Row
  For Each cll In .Range("H2:Q" & Finalrow)
    If cll.Value > 0 Then
      DSht.Cells(DestRow, "F") = cll.Value
      DSht.Cells(DestRow, "A").Resize(, 4) = .Cells(cll.Row, "D").Resize(, 4).Value
      DSht.Cells(DestRow, "E") = .Cells(1, cll.Column).Value
      DestRow = DestRow + 1
    End If
  Next cll
End With
End Sub
I didn't look very closely at your code, I went by your narrative, however, one thing; where you have the hard-coded '9', the 9 represents the column on the Day sheet, it needed to be a variable moving from 8 to 17 in another loop.
 
Upvote 0
p45cal,

i need this exact code, except i need the copied value for

DSht.Cells(DestRow, "F") = cll.Value

to be one cell to the left of cll.Value.

i haven't been able to correctly code that location without it throughing an Application-defined or object-defined error.

can you help with that?

dh
 
Upvote 0
here is the current state of my code if that helps:

Sub test()
Dim c As Range, d As Long
For Each c In Range("C2:C14")
If c > 0 Then
Sheets("Sheet2").Range("D4").Offset(, d) = c.(0,-1).value
d = d + 1
End If
Next
End Sub
 
Upvote 0
Ok, one more thing, I realized after talking to the user, the columns are entered based on people so one day the last column could be BD and one day CG, I know there is a FINALCOL that will find last column, but I can't get it built into the code below:

For Each cll In .Range("H2:bd" & finalrow)

I tried For Each cll In .Range("H2" & ":" & finalcol & finalrow) (and several variations of this), but it would work, I named the finalcol

Finalcol = Cells(1, 255).End(xlToLeft).Column

So here is my code but I changed the For each back to what you had for clarity:

Sub blahcc()
Set DSht = Sheets("Input")
DestRow = DSht.Cells(DSht.Rows.Count, "A").End(xlUp).Row + 1
With Sheets("WeekDay")
finalrow = .Range("j65536").End(xlUp).Row
Finalcol = Cells(1, 255).End(xlToLeft).Column
For Each cll In .Range("H2:bd" & finalrow)
If cll.Value > 0 Then
DSht.Cells(DestRow, "h") = cll.Value
DSht.Cells(DestRow, "A").Resize(, 6) = .Cells(cll.Row, "f").Resize(, 6).Value
DSht.Cells(DestRow, "g") = .Cells(1, cll.Column).Value
DestRow = DestRow + 1
End If
Next cll
End With
End Sub

I hate to bother again, I even tried googling it. Thanks in advance.
 
Upvote 0
As long as the last column found in row 1 is always going to be to the right of column H this should work:
Code:
For Each cll In Range(.Range("H2"), .Cells(finalrow, finalcol))
One thing worries me, you said "to be one cell to the left of cll.Value"; are you saying that you should be running from column G instead of Column H? If so change the H in the code line above to a G, no offsets. But I'm not clear on just why you want the cell to the left of cll.
 
Upvote 0

Forum statistics

Threads
1,213,524
Messages
6,114,117
Members
448,549
Latest member
brianhfield

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top