VBA Code to loop through each row

Simondo

New Member
Joined
Jun 10, 2014
Messages
13
Hi All,

I have the following code that runs well.

Code:
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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

ChrisBM

Board Regular
Joined
Sep 22, 2014
Messages
215
Code:
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

Board Regular
Joined
Sep 22, 2014
Messages
215
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

New Member
Joined
Jun 10, 2014
Messages
13
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

Code:
[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

New Member
Joined
Jun 10, 2014
Messages
13
Hi ChrisBM,

Thanks for your help,

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

Code:
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

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

from your code and seems ok.

Thanks again for your help
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,704
Messages
5,833,221
Members
430,197
Latest member
edeibold

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
Top