CODEWITHSUNDEEP
vbaexcelruntime-error
Kurst
Kurst

Reputation: 11

Runtime Error in VBA Project

I keep getting an error whenever I run this code. The error is a 1004 runtime error. Please help me figure out where my code went wrong. I am completely new to VBA but I do know how to use Python and C. 

Option Explicit

Sub Experiment()

    Dim m1 As Worksheet
    Set m1 = ThisWorkbook.Worksheets("Sheet1")

    Dim col As Integer
    Dim row As Integer

    Dim initial As Double

    Dim s1 As Double
    Dim s1_pos As Integer
    Dim s2 As Double
    Dim s2_pos As Integer

    Dim min As Double
    Dim candidate As Double
    Dim temp_swap As Double

    Dim r As Integer

    col = 2
    'For col = 2 To 18 Step 3
    For row = 5 To 47 Step 2
        initial = m1.Cells(row, col).Value
        s1 = m1.Cells(row + 1, col).Value
        s1_pos = row + 1
        min = Abs(36 - (initial + s1))
        r = row + 1

        Do While r < 49
            s2 = m1.Cells(r, col).Value
            candidate = Abs(36 - (initial + s2))
            If candidate < min Then
                min = candidate
                s2_pos = r
            End If
            r = r + 1
        Loop

        temp_swap = s1
        m1.Cells(s1_pos, col).Value = s2
        m1.Cells(s2_pos, col).Value = temp_swap

    Next row

End Sub

Upvotes: 0

Views: 112

Answers (2)

Shai Rado
Shai Rado

Reputation: 33682

The code below (which I tested), loops through rows 5 to 48 (like in your code), and finds (per row) the most suitable capacitor (together they have a value closest to 36). I made some modification to the code, to make it run faster, and I think easier for you to follow.

The screen-shot below shows the results I got on my Demo (Column C gets the row number of the capacitor with the best match, Column D shows that capacitor value) enter image description here

Here is the code :

Option Explicit

Sub Experiment()

Dim m1 As Worksheet
Set m1 = ThisWorkbook.Worksheets("Sheet1")

Dim col As Integer
Dim row As Integer
Dim i As Integer

Dim Capacitor_Val           As Double
Dim Current_Rng             As Range
Dim Row_Found               As Long
Dim Minimum_Gap             As Double

col = 2

For row = 5 To 47
    ' just a high value to reset this flag
    Minimum_Gap = 3
    For i = row + 1 To 48
        If Abs(36 - (m1.Cells(i, col) + m1.Cells(row, col))) < Minimum_Gap Then
            Minimum_Gap = Abs(36 - (m1.Cells(i, col) + m1.Cells(row, col)))
            Row_Found = i
            Capacitor_Val = m1.Cells(i, col)
        End If
    Next i     

    m1.Cells(row, col + 1).Value = Row_Found
    m1.Cells(row, col + 2).Value = Capacitor_Val

Next row

End Sub

Upvotes: 0

Gary Evans
Gary Evans

Reputation: 1890

I was able to replicate the issue by setting either s2_pos or col to 0. In your code this would occur if candidate < min was never true, as the result would be that s2_pos never gets set.

I would suggest stepping through your code using F8 to understand how you get to this scenario in your data.

As a workaround, place s2_pos = 0 before Do While r < 49 and then wrap the last few lines in the below is statement.

If s2_pos <> 0 then
    temp_swap = s1
    m1.Cells(s1_pos, col).Value = s2
    m1.Cells(s2_pos, col).Value = temp_swap
End If

Upvotes: 1

Related Questions