check date to see if code can be run

[alan myers]

Sub CopyTranspose()

Dim rowPay As Long, colPay As Long, rowComb As Long
Dim nCarrier As Long, irowComb As Long, icolPay As Long
Dim rngCopy As Range, rngPaste As Range
Dim wb As Workbook
Dim wsPayroll As Worksheet, wsCombine As Worksheet

Set wb = ActiveWorkbook
Set wsPayroll = wb.Sheets("Payroll")
Set wsCombine = wb.Sheets("Combine")

Application.ScreenUpdating = False

' Get next empty row
rowPay = wsPayroll.Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
' Initital column in wsPayroll
icolPay = 3
' Initital row on wsCombine
irowComb = 3

For nCarrier = 0 To 194
    colPay = icolPay + (nCarrier * 11)
    rowComb = irowComb + (nCarrier * 12)
    Set rngCopy = wsCombine.Range("B" & rowComb).Resize(10, 1)
    Set rngPaste = wsPayroll.Cells(rowPay, colPay)
    rngPaste.Resize(1, rngCopy.Rows.Count) = Application.WorksheetFunction.Transpose(rngCopy.Value)
Next

End Sub

https://www.mediafire.com/file/bbx1vzl6ccuepzf/Payroll+v3.xlsm/file my file

before this code is run I need to check the payroll tab to find the next empty row then check that rows date in column a if it matches today's date then run the code else end

like to and this code to the start of my code

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug. My signature block below has more details. I have added them for you this time. ?

 

[Peter_SSs]

before this code is run I need to check the payroll tab to find the next empty row then check that rows date in column a if it matches today's date then run the code else end

Try adding these two red lines where shown

Sub CopyTranspose()

  Dim rowPay As Long, colPay As Long, rowComb As Long
  Dim nCarrier As Long, irowComb As Long, icolPay As Long
  Dim rngCopy As Range, rngPaste As Range
  Dim wb As Workbook
  Dim wsPayroll As Worksheet, wsCombine As Worksheet
  
  Set wb = ActiveWorkbook
  Set wsPayroll = wb.Sheets("Payroll")
  Set wsCombine = wb.Sheets("Combine")
  
  If wsPayroll.Range("A" & wsPayroll.Range("BHE" & Rows.Count).End(xlUp).Row + 1).Value = Date Then
    Application.ScreenUpdating = False
    
    ' Get next empty row
    rowPay = wsPayroll.Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
    ' Initital column in wsPayroll
    icolPay = 3
    ' Initital row on wsCombine
    irowComb = 3
    
    For nCarrier = 0 To 194
        colPay = icolPay + (nCarrier * 11)
        rowComb = irowComb + (nCarrier * 12)
        Set rngCopy = wsCombine.Range("B" & rowComb).Resize(10, 1)
        Set rngPaste = wsPayroll.Cells(rowPay, colPay)
        rngPaste.Resize(1, rngCopy.Rows.Count) = Application.WorksheetFunction.Transpose(rngCopy.Value)
    Next
  End If
End Sub

 

[alan myers]

Try adding these two red lines where shown

Sub CopyTranspose()

  Dim rowPay As Long, colPay As Long, rowComb As Long
  Dim nCarrier As Long, irowComb As Long, icolPay As Long
  Dim rngCopy As Range, rngPaste As Range
  Dim wb As Workbook
  Dim wsPayroll As Worksheet, wsCombine As Worksheet
 
  Set wb = ActiveWorkbook
  Set wsPayroll = wb.Sheets("Payroll")
  Set wsCombine = wb.Sheets("Combine")
 
  If wsPayroll.Range("A" & wsPayroll.Range("BHE" & Rows.Count).End(xlUp).Row + 1).Value = Date Then
    Application.ScreenUpdating = False
   
    ' Get next empty row
    rowPay = wsPayroll.Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
    ' Initital column in wsPayroll
    icolPay = 3
    ' Initital row on wsCombine
    irowComb = 3
   
    For nCarrier = 0 To 194
        colPay = icolPay + (nCarrier * 11)
        rowComb = irowComb + (nCarrier * 12)
        Set rngCopy = wsCombine.Range("B" & rowComb).Resize(10, 1)
        Set rngPaste = wsPayroll.Cells(rowPay, colPay)
        rngPaste.Resize(1, rngCopy.Rows.Count) = Application.WorksheetFunction.Transpose(rngCopy.Value)
    Next
  End If
End Sub

thanks work fine just what i needed you guys are great

 

[Peter_SSs]

You're welcome. Thanks for the confirmation.