Need help with VBA code prompting Compile error: Next without For

P

Pi_Lover

Board Regular
Joined
Nov 3, 2023
Messages
55
Office Version
  1. 365
Platform
  1. Windows
Good morning. I have some VBA code in a UserForm to execute when a CommandButton is clicked. I had the original code only looking in the worksheet Index in one column (AH) to find any value >0 to then look in the same row column AE and copy and paste the values into worksheet Qtrax_Update_Sheet. Column AE value would be pasted in column A in the first row available starting at the second row, and then the value in column H would be pasted into the column array (B:H) depending on what day it is. Column B being Monday and column H being Sunday. The next step in the code would then delete all the values >0 in column AH in the original worksheet Index and all the values pasted to the new worksheet Qtrax_Update_Sheet would then populate a ListBoxQTRAX. It functioned correctly when the code only included the beforementioned columns iin worksheet Index. Now that I added the rest of the columns for it to perform the same exercise on, it is prompting a Complie error: Next without For error. Can someone take a look at my code and see what the issue may be please? I can upload a link to Dropbox for you to work with it, if need be. See code below:

VBA Code: 
Private Sub CommandButtonUpdateList_Click()
    Dim wsIndex As Worksheet
    Dim wsQTRAX As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim dayOfWeek As Integer
    Dim targetColumn As Integer
    Dim colHeaders As Variant
    Dim dataRange As Range
    Dim combinedData As Variant
    Dim j As Long
    
    ' Set references to worksheets
    Set wsIndex = ThisWorkbook.Sheets("Index")
    Set wsQTRAX = ThisWorkbook.Sheets("QTRAX_Update_Sheet")
    
    ' Find the last row in the Index sheet
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "AH").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "AS").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "BD").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "BO").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "BZ").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "CK").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "CV").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "DG").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "DR").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "EC").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "EN").End(xlUp).Row
    lastRow = wsIndex.Cells(wsIndex.Rows.Count, "EY").End(xlUp).Row
    
    ' Determine the day of the week (1 = Sunday, 2 = Monday, ..., 7 = Saturday)
    dayOfWeek = Weekday(Date, vbMonday) ' Use vbMonday to start with Monday
    
    ' Calculate the target column in QTRAX_Update_Sheet
    targetColumn = dayOfWeek + 1 ' Add 1 to skip column A (AE value)
    
    ' Loop through rows in Index sheet
    For i = 2 To lastRow
        ' Check if value in column AH is greater than 0
        If wsIndex.Cells(i, "AH").Value > 0 Then
        If wsIndex.Cells(i, "AS").Value > 0 Then
        If wsIndex.Cells(i, "BD").Value > 0 Then
        If wsIndex.Cells(i, "BO").Value > 0 Then
        If wsIndex.Cells(i, "BZ").Value > 0 Then
        If wsIndex.Cells(i, "CK").Value > 0 Then
        If wsIndex.Cells(i, "CV").Value > 0 Then
        If wsIndex.Cells(i, "DG").Value > 0 Then
        If wsIndex.Cells(i, "DR").Value > 0 Then
        If wsIndex.Cells(i, "EC").Value > 0 Then
        If wsIndex.Cells(i, "EN").Value > 0 Then
        If wsIndex.Cells(i, "EY").Value > 0 Then
        
            ' Copy value from column AE in Index sheet
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "AE").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "AP").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "BA").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "BL").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "BW").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "CH").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "CS").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "DD").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "DO").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "DZ").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "EK").Value
            wsQTRAX.Cells(i, 1).Value = wsIndex.Cells(i, "EV").Value
            
            ' Paste value in the appropriate column in QTRAX_Update_Sheet
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "AH").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "AS").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "BD").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "BO").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "BZ").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "CK").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "CV").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "DG").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "DR").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "EC").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "EN").Value
            wsQTRAX.Cells(i, targetColumn).Value = wsIndex.Cells(i, "EY").Value
            
            ' Delete value in column AH
            wsIndex.Cells(i, "AH").Value = ""
            wsIndex.Cells(i, "AS").Value = ""
            wsIndex.Cells(i, "BD").Value = ""
            wsIndex.Cells(i, "BO").Value = ""
            wsIndex.Cells(i, "BZ").Value = ""
            wsIndex.Cells(i, "CK").Value = ""
            wsIndex.Cells(i, "CV").Value = ""
            wsIndex.Cells(i, "DG").Value = ""
            wsIndex.Cells(i, "DR").Value = ""
            wsIndex.Cells(i, "EC").Value = ""
            wsIndex.Cells(i, "EN").Value = ""
            wsIndex.Cells(i, "EY").Value = ""
        End If
    Next i
    
    ' Populate listboxQTRAX with column headers from row 1 in QTRAX_Update_Sheet
    colHeaders = wsQTRAX.Range("A1:H1").Value
    
    ' Populate the values below the headings
    Set dataRange = wsQTRAX.Range("A2:H" & lastRow)
    
    ' Combine headers and data into a single array
    ReDim combinedData(1 To lastRow, 1 To 8)
    For j = 1 To 8
        combinedData(1, j) = colHeaders(1, j)
    Next j
    For i = 2 To lastRow
        For j = 1 To 8
            combinedData(i, j) = dataRange.Cells(i - 1, j).Value
        Next j
    Next i
    
    ' Assign the combined data to the listbox
    Me.ListBoxQTRAX.ColumnCount = 8
    Me.ListBoxQTRAX.List = combinedData
    
    ' Set individual column widths (adjust as needed)
    Me.ListBoxQTRAX.ColumnWidths = "40;38;38;52;47;32;40;42"
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Every single "IF...THEN" line needs a corresponding "END IF" line.
You have 12 "IF...THEN" statements, but only 1 "END IF".
 
Upvote 0
Joe4 said:
Every single "IF...THEN" line needs a corresponding "END IF" line.
You have 12 "IF...THEN" statements, but only 1 "END IF".
Click to expand...
So I need to enter in 12 total End If statements?
 
Upvote 0
Joe4 said:
Every single "IF...THEN" line needs a corresponding "END IF" line.
You have 12 "IF...THEN" statements, but only 1 "END IF".
Click to expand...
I added in the 12 End If statements, however it did not execute the rest of the code. Meaning, it added the existing values from the worksheet Qtrax_Update_Sheet, but it did not copy and paste the new values in worksheet Index in the columns with values >0. Any idea on what I may be doing incorrectly?
 
Upvote 0
Can you explain to me exactly what you are trying to do with these 12 consecutive IF...THEN statements?
VBA Code: 
        ' Check if value in column AH is greater than 0
        If wsIndex.Cells(i, "AH").Value > 0 Then
        If wsIndex.Cells(i, "AS").Value > 0 Then
        If wsIndex.Cells(i, "BD").Value > 0 Then
        If wsIndex.Cells(i, "BO").Value > 0 Then
        If wsIndex.Cells(i, "BZ").Value > 0 Then
        If wsIndex.Cells(i, "CK").Value > 0 Then
        If wsIndex.Cells(i, "CV").Value > 0 Then
        If wsIndex.Cells(i, "DG").Value > 0 Then
        If wsIndex.Cells(i, "DR").Value > 0 Then
        If wsIndex.Cells(i, "EC").Value > 0 Then
        If wsIndex.Cells(i, "EN").Value > 0 Then
        If wsIndex.Cells(i, "EY").Value > 0 Then

Are you trying to check for exactly ALL 12 conditions being True at the same time?
Or are you just trying to check if any one of those 12 conditions is True?

Pi_Lover said:
See below for Dropbox linnk:
Click to expand...
Unfortunately, I am not at a place were I can download any files right now.
 
Upvote 0
I am trying to check if any one of them have the condition, and, if so, copy and paste those values over to tte new worksheet
 
Upvote 0
Pi_Lover said:
I am trying to check if any one of them have the condition, and, if so, copy and paste those values over to tte new worksheet
Click to expand...
So, if ANY of them are True, do you want to copy ALL the values over, or just specific ones (depending on which of them are greater than 0)?
Or another way of saying it is this: Does the values that you copy over depend of which of those values are greater than 0?

If so, your code is not structured correctly.
 
Upvote 0
Yes sir, if any of the values are True, then I want all the values to copy and be pasted. Any value greater than 0. For each column
 
Upvote 0
If you want the exact same thing to happen in each case, if at least one of those cells has a value greater than zero, then I think you should only need one IF...THEN, i.e
VBA Code: 
    If (wsIndex.Cells(i, "AH").Value > 0) _
        Or (wsIndex.Cells(i, "AS").Value > 0) _
        Or (wsIndex.Cells(i, "BD").Value > 0) _
        Or (wsIndex.Cells(i, "BO").Value > 0) _
        Or (wsIndex.Cells(i, "BZ").Value > 0) _
        Or (wsIndex.Cells(i, "CK").Value > 0) _
        Or (wsIndex.Cells(i, "CV").Value > 0) _
        Or (wsIndex.Cells(i, "DG").Value > 0) _
        Or (wsIndex.Cells(i, "DR").Value > 0) _
        Or (wsIndex.Cells(i, "EC").Value > 0) _
        Or (wsIndex.Cells(i, "EN").Value > 0) _
        Or (wsIndex.Cells(i, "EY").Value > 0) Then
Then you would only one one END IF.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
925
Peter_SSs
Peter_SSs
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
329
RoryA
RoryA
K
  • Question Question
Help Needed
2
Replies
13
Views
319
kwavic
K
N
  • Solved
how to automatically clear text if text in another cell is removed
Replies
1
Views
111
Joe4
Joe4
S
  • Question Question
Multiple columns lookup
Replies
0
Views
262
Sipirili2504
S

Forum statistics

Threads
1,223,867
Messages
6,175,069
Members
452,611
Latest member
bls2024

Share this page

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