VBA Code to loop through each row

[Simondo]

Hi All,

I have the following code that runs well.

Sub matchEm()

Sheets("Timesheet Log").Unprotect "ops9999"


Application.Screenupdating = False


    Dim vRow, vColumn
    Dim sht1 As Excel.Worksheet
    Dim sht2 As Excel.Worksheet
        
    Set sht1 = Sheets("Sheet1")
    Set sht2 = Sheets("Timesheet Log")
    vRow = Application.Match(sht1.Range("A2").Value, sht2.Range("B:B"), 0)
    If Not IsError(vRow) Then
        vColumn = Application.Match(sht1.Range("B4").Value2, sht2.Range("2:2"), 0)
        If Not IsError(vColumn) Then sht2.Cells(vRow, vColumn).Resize(5).Value = Application.Transpose(sht1.Range("G2:K2").Value)
End If


Sheets("Timesheet Log").Protect "ops9999", True, True
Application.Screenupdating = True


End Sub

What I would like to do is have this code run through rows 1:200 on Sheet1 and run the code on each line, I'm sure I could copy and paste this code 200 times changing the Range each time, but there has to be an easier way

Thanks in advance for your replies,

Simon

 

[ChrisBM]

Sub matchEm()Sheets("Timesheet Log").Unprotect "ops9999"

Application.Screenupdating = False    

Dim vRow, vColumn    
Dim sht1 As Excel.Worksheet:Set sht1 = Sheets("Sheet1")
Dim sht2 As Excel.Worksheet:Set sht2 = Sheets("Timesheet Log")    

'Here is where the loop starts
For i = 1 to 200
      vRow = Application.Match(sht1.Range("A" & i).Value, sht2.Range("B:B"), 0)    
      If Not IsError(vRow) Then        
               vColumn = Application.Match(sht1.Range("B4").Value2, sht2.Range("2:2"), 0)        
      End If

      If Not IsError(vColumn) Then 
               sht2.Cells(vRow, vColumn).Resize(5).Value = Application.Transpose(sht1.Range("G" & i & ":K" & i).Value)
      End If



Next

Sheets("Timesheet Log").Protect "ops9999", True, True
Application.Screenupdating = True
End Sub

 

[ChrisBM]

Just adapt the loop and put i where you need the row (or i+1 or i+2 as suits)...

Hope this helps,
Chris

 

[Simondo]

Thanks for your Quick Reply,

I am new enough to VBA but can clearly make sense of your code, however I am getting a 'Type Mismatch' on the following line

[COLOR=#333333]sht2.Cells(vRow, vColumn).Resize(5).Value = Application.Transpose(sht1.Range("G" & i & ":K" & i).Value)[/COLOR]

Any Idea what might be causing it?

 

[Simondo]

Hi ChrisBM,

Thanks for your help,

I played around with your code a bit and ended up with the following code which runs well.

Sub match()

Sheets("Timesheet Log").Unprotect "ops9999"


Application.Screenupdating = False


Dim vRow, vColumn
Dim sht1 As Excel.Worksheet: Set sht1 = Sheets("Sheet1")
Dim sht2 As Excel.Worksheet: Set sht2 = Sheets("Timesheet Log")


'Here is where the loop starts
For i = 1 To 200
      vRow = Application.match(sht1.Range("A" & i).Value, sht2.Range("B:B"), 0)
      If Not IsError(vRow) Then
               vColumn = Application.match(sht1.Range("E2").Value2, sht2.Range("2:2"), 0)
     
               sht2.Cells(vRow, vColumn).Resize(5).Value = Application.Transpose(sht1.Range("G" & i & ":K" & i).Value)
      End If


Next


Sheets("Timesheet Log").Protect "ops9999", True, True
Application.Screenupdating = True


End Sub

I just removed the

End If
[/COLOR][COLOR=#333333]If Not IsError(vColumn) Then[/COLOR][COLOR=#333333]

from your code and seems ok.

Thanks again for your help