Results 1 to 2 of 2

Thread: VBA Loop refuses to work
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA Loop refuses to work

    hi,

    I am trying to get this macro to run where there is a number in a cell then it takes the main header and the sub header and transposes it then adds the value but for some reason it refuses to work. the loop variable e.g. datarow for example is set at datarow = 3 but it appears as blank and while the loop runs nothing happens.

    anyone have any idea?

    see below example of macro


    Code:
    Sub Step_2()
    
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim shtcopy As Worksheet
    Dim shtfinal As Worksheet
    Dim LastRow As Long
    
    
    'change this to the drive
    Const strPath As String = "C:\Users\omar.uni\Desktop\Timesheets"
    
    
    ChDir strPath
        strExtension = Dir("*.xls*")
        
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
          With wkbSource
          LastRow = Sheets("Actual Hours").Cells(Rows.Count, "A").End(xlUp).Row
          Set shtcopy = Sheets("Sheet1") 'IF WORKSHEET NAME CHANGES
          Set shtfinal = Sheets("Sheet4")
            DataRow = 3
        OutRow = 2
        Role1Col = 16
          Do Until shtcopy.Cells(DataRow, "A") = ""
            OutStart = OutRow
            RoleCol = Role1Col
            Do Until shtcopy.Cells(2, RoleCol) = ""
              If shtcopy.Cells(DataRow, RoleCol) > 0 Then
                shtfinal.Cells(OutRow, Role1Col).Value = .shtcopy.Cells(1, Role1Col + VBA.Int((RoleCol - Role1Col) / 3) * 3).Value
                shtfinal.Cells(OutRow, Role1Col + 1).Value = .shtcopy.Cells(2, RoleCol).Value
                shtfinal.Cells(OutRow, Role1Col + 2).Value = .shtcopy.Cells(DataRow, RoleCol).Value
                OutRow = OutRow + 1
              End If
              RoleCol = RoleCol + 1
            Loop
            If OutStart <> OutRow Then
              .shtcopy.Range(.shtcopy.Cells(DataRow, 1), .shtcopy.Cells(DataRow, Role1Col - 1)).Copy .shtfinal.Range(.shtfinal.Cells(OutStart, 1), shtfinal.Cells(OutRow - 1, Role1Col - 1))
            End If
            DataRow = DataRow + 1
          Loop
        End With
        strExtension = Dir()
      Loop
    
    
    MsgBox ("Step 2 complete move to step 3!")
    GoTo Exitsub
    
    
    Exitsub:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    End Sub

    any help will be greatly appreciated!
    Last edited by RoryA; Sep 4th, 2019 at 08:43 AM. Reason: Code tags

  2. #2
    New Member
    Join Date
    Aug 2019
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Loop refuses to work need help desperately!

    Never mind sorted!
    Last edited by RoryA; Sep 4th, 2019 at 08:43 AM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •