VBA for, next, if Help

hajiali

Well-known Member
Joined
Sep 8, 2018
Messages
623
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
Sub PermanentBid()
Dim Dq, cell, AgentDC, TdDc, Rslt, rx As Range
Dim arr
Dim r, c, i, bD, Ee As Long
With Sheets("FORM")
Set Dq = Range("DQ3:DQ500")
Set AgentDC = Range("D3:d114")
Set TdDc = Worksheets("TOOL").Range("AF3:AF603")
Ee = Range("D1")
bD = Worksheets("DATA").Cells(Rows.Count, 5).End(xlUp).Row + 1
For Each cell In Dq
    If cell.Value <> "" Then
        Range("A1").Value = cell.Value
        arr = AgentDC
            For r = 1 To 112
                For c = 1 To 1
                    If Not arr(r, c) = "" Then
                        For i = 1 To 603
                            If TdDc.Cells(i) = arr(r, c) Then
                                With Sheets("Results")
                                    Set Rslt = .Range("F2:F603").Find(TdDc.Cells(i).Offset(, -31), lookat:=xlWhole)
                                        If Rslt Is Nothing Then
                                            Worksheets("DATA").Cells(bD, "E").Value = cell.Value
                                            Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)
                                        Else
                                            If Rslt.Offset(, -3) > Ee Then
                                                Worksheets("DATA").Cells(bD, "E").Value = cell.Value
                                                Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)
                                            End If
                                        End If
                                End With
                            End If
                        Next
                    End If
                Next
            Next
    End If
Next cell
End With
End Sub

I needing a little help with above VBA. with all the for and if that I have its got my head spinning lol. what Im needing done after

VBA Code:
 If Rslt Is Nothing Then
         Worksheets("DATA").Cells(bD, "E").Value = cell.Value
         Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)

and

VBA Code:
If Rslt.Offset(, -3) > Ee Then
       Worksheets("DATA").Cells(bD, "E").Value = cell.Value
       Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)
End If

is to move to the

VBA Code:
Next cell
instead of going through the rest of the for so. is there a better way to recode this to do this.

so if go form Ln 289 to 303 or Ln293 to 303

Any help is greatly appreciated.
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
It's not clear what condition you want to cause to abandon the inner For loops and go directly to the Next cell. Do you mean if either of those If conditions is TRUE, you want to go directly to Next cell?
 
Upvote 0
correct so once the cell. Value should appear once in the Data sheets so once the occurs for either of the conditions go directly to the next Cell value. found out after some research to use "goto" in vba to make this happen is there an alternative.

.
 
Upvote 0
Normally I avoid GoTo at all costs. But you have a somewhat unusual requirement. I don't know what you are trying to do with this code so I don't know how to recommend a restructuring of the overall code. However, adding a GoTo would have minimal impact.

Rich (BB code):
Sub PermanentBid()
Dim Dq, cell, AgentDC, TdDc, Rslt, rx As Range
Dim arr
Dim r, c, i, bD, Ee As Long
With Sheets("FORM")
Set Dq = Range("DQ3:DQ500")
Set AgentDC = Range("D3:d114")
Set TdDc = Worksheets("TOOL").Range("AF3:AF603")
Ee = Range("D1")
bD = Worksheets("DATA").Cells(Rows.Count, 5).End(xlUp).Row + 1
For Each cell In Dq
    If cell.Value <> "" Then
        Range("A1").Value = cell.Value
        arr = AgentDC
            For r = 1 To 112
                For c = 1 To 1
                    If Not arr(r, c) = "" Then
                        For i = 1 To 603
                            If TdDc.Cells(i) = arr(r, c) Then
                                With Sheets("Results")
                                    Set Rslt = .Range("F2:F603").Find(TdDc.Cells(i).Offset(, -31), lookat:=xlWhole)
                                        If Rslt Is Nothing Then
                                            Worksheets("DATA").Cells(bD, "E").Value = cell.Value
                                            Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)
                                            GoTo NextCell
                                        Else
                                            If Rslt.Offset(, -3) > Ee Then
                                                Worksheets("DATA").Cells(bD, "E").Value = cell.Value
                                                Worksheets("DATA").Cells(bD, "F").Value = TdDc.Cells(i).Offset(, -31)
                                                GoTo Next Cell
                                            End If
                                        End If
                                End With
                            End If
                        Next
                    End If
                Next
            Next
    End If
NextCell:
Next cell
End With
End Sub
 
Upvote 0
Solution
That's what I need to be done thank you so much.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

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