VBA repair

R

RailEngineer76

New Member
Joined
Feb 3, 2023
Messages
9
Office Version
  1. 2010
Platform
  1. Windows
Hi,
I have a VBA spreadsheet but it seems to have become corrupted over the years and now gives a run-error and doesn't compete the calculations.
I admit my VBA knowledge is lacking and I cant find where the mistake has occurred.
Can anyone help?

How do I add the file with the code?
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
RailEngineer76 said:
How do I add the file with the code?
Click to expand...
This forum doesn't allow file uploads. You'd have to use some type of drop box, assuming anyone will download a file from there. Alternative would be to post code (please use code tags - vba button on posting toolbar - to maintain indentation and readability) and some data if it's needed. You could post the error number and message as well. Pics of data/code are of little use to anyone beyond showing what line causes an error.

When the error occurs, does Excel open the code window and highlight the problem line?
 
Upvote 0
Hi Micron,

Let me know if you need more details?

Dave


VBA Code: 
Function jechane()
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Activate
    If ActiveSheet.Name <> "NAPIER" And ActiveSheet.Name <> "Progress" And ActiveSheet.Name <> "Interpolation Values" Then usun
    
    Sheets("NAPIER").Select
    Application.ScreenUpdating = False
    wheelbase = 8.5
    minlevel = Range("B3")
    Range("A4").Select
    zasieg = 20 / (Cells(Rows.Count, 1).End(xlUp).Row - 2)
    ilosc = Cells(Rows.Count, 1).End(xlUp).Value * 10 + 2
    licznik = 1
    Sheets("Interpolation Values").Visible = True
    Sheets("Progress").Visible = True
    Sheets("Progress").Range("A10:U10").ClearContents
    Sheets("Progress").Range("A1").ClearContents
    Application.Calculation = xlCalculationManual
    Do Until ActiveCell.Offset(1, 0).Value = ""
        wheelbase = 8.5
        chain = ActiveCell.Value
        level = ActiveCell.Offset(0, 1).Value
        Sheets("Interpolation Values").Select
        Sheets("Interpolation Values").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = chain
        Sheets(Sheets.Count).Activate
        Range("A3:D4").Select
        Selection.AutoFill Destination:=Range(Cells(3, 1), Cells(ilosc, 4)), Type:=xlFillDefault
        Range(Cells(3, 1), Cells(ilosc, 4)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        
qqrq:
        Cells(Rows.Count, 12).End(xlUp).Select
        ActiveCell.Offset(-1, 0).Select
        wiersz2 = ActiveCell.Row
        Cells(wiersz2, 6).Value = level
        Cells(wiersz2, 7).Value = chain
        Cells(wiersz2, 8).Value = wheelbase
        Cells(wiersz2 + 1, 8).Value = wheelbase
        
        'Range("F3").Value = level
        'Range("G3").Value = chain
        'Range("H3").Value = wheelbase
        ActiveCell.Value = 0.1
        ActiveCell.Offset(0, 1).Value = wheelbase - 0.1
        Do Until ActiveCell.Value = wheelbase - 0.1 Or ActiveCell.Value = chain
            ActiveCell.Offset(1, 0).Value = ActiveCell.Value + 0.1
            ActiveCell.Offset(1, 1).Value = ActiveCell.Offset(0, 1).Value - 0.1
            ActiveCell.Offset(1, 0).Select
        Loop
        wiersz = ActiveCell.Row
        Range(Cells(wiersz2, 8), Cells(wiersz2 + 1, 11)).Select
        Selection.AutoFill Destination:=Range(Cells(wiersz2, 8), Cells(wiersz, 11)), Type:=xlFillDefault
        Range(Cells(wiersz2, 14), Cells(wiersz2 + 1, 27)).Select
        Selection.AutoFill Destination:=Range(Cells(wiersz2, 14), Cells(wiersz, 27)), Type:=xlFillDefault
        
        Range(Cells(wiersz2, 8), Cells(wiersz, 27)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        
        If wheelbase <> 15.3 Then
            Cells(Rows.Count, 12).End(xlUp).Select
            ActiveCell.Offset(4, -6).Select
            wiersz2 = ActiveCell.Row
            Range(Cells(3, 6), Cells(4, 27)).Copy Range(Cells(wiersz2, 6), Cells(wiersz2 + 1, 27))
            If wheelbase = 9.75 Then wheelbase = 15.3
            If wheelbase = 8.5 Then wheelbase = 9.75
            GoTo qqrq
        End If
        
        Range("A3").Select
        
        postep = zasieg * licznik
        
        Sheets("Progress").Select
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Cells(10, Round(postep, 0) + 1).Value = 1
        Range("K12").Value = licznik / (20 / zasieg)
        Application.ScreenUpdating = False
        Sheets("NAPIER").Select
        ActiveCell.Offset(1, 0).Select
        licznik = licznik + 1
    Loop
    Sheets("Progress").Select
    Application.ScreenUpdating = True
    Cells(10, 21).Value = 1
    Range("K12").Value = 1
    a = MsgBox("Completed", vbOKOnly, "Congratulations!")
    Application.ScreenUpdating = False
    Sheets("NAPIER").Select
    Range("A3").Select
    Sheets("Interpolation Values").Visible = False
    Sheets("Progress").Visible = False
End Function

Function usun()
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Activate
    If ActiveSheet.Name <> "NAPIER" And ActiveSheet.Name <> "Progress" And ActiveSheet.Name <> "Interpolation Values" Then
        a = MsgBox("Do You want to delete results sheets and recalculate the project?", vbOKCancel, "Warning")
        If a = vbOK Then
            Application.DisplayAlerts = False
            Application.Calculation = xlCalculationManual
            Do Until ActiveSheet.Name = "NAPIER"
                Sheets(Sheets.Count).Select
                If ActiveSheet.Name <> "NAPIER" Or ActiveSheet.Name <> "Progress" Or ActiveSheet.Name <> "Interpolation Values" Then
                    Sheets(Sheets.Count).Delete
                End If
            Loop
            Application.Calculation = xlCalculationAutomatic
            Application.DisplayAlerts = True
            Sheets("NAPIER").Select
        Else
            Sheets("NAPIER").Select
            Exit Function
        End If
    Else
        If Sheets.Count = 3 Then a = MsgBox("No resluts sheets found", vbOKOnly, "Warning")
    End If
End Function

Some sample values this refers to
Chainage first column, level 2nd column and distance in third column

5.0​
99.223​
-27.5​
10.0​
99.323​
-22.5​
12.0​
99.352​
-20.5​
14.0​
99.429​
-18.5​
16.0​
99.463​
-16.5​
18.0​
99.517​
-14.5​
20.0​
99.561​
-12.5​
21.0​
99.578​
-11.5​
22.0​
99.614​
-10.5​
 

Attachments

  • Error.JPG
    Error.JPG
    27.1 KB · Views: 8
  • After pressing End on Error Message.JPG
    After pressing End on Error Message.JPG
    98.6 KB · Views: 8
  • Capture.JPG
    Capture.JPG
    69.6 KB · Views: 9
Upvote 0
After reviewing all of that I have no idea what line triggers the error so at this point, no clue. IMO 1004 error has to be the least helpful Excel vba error there is. Try stepping through your code and validating the values of variables as you go.

I always declare my variables, otherwise they are always all variant data type. Every module I create has Option Explicit at the top by default and that's always my recommendation.
 
Upvote 0
Micron said:
I have no idea what line triggers the error so at this point, no clue.
Click to expand...
I guess that requires clarification: You have not shown what line raises the error.
Or if you did, I missed it.
 
Upvote 0
Doesn't the code break on the offending line and highlight it? If not, then step through it as suggested?
 
Upvote 0
Micron said:
Doesn't the code break on the offending line and highlight it? If not, then step through it as suggested?
Click to expand...
No, it doesn't break and highlight the offending line. I'll see if I can work it out.
Thanks anyway.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Unable to Open or Copy Corrupted Excel Files on Network Drive
Replies
1
Views
158
Candyman8019
C
E
  • Question Question
Can I eliminate this "File Now Available" -- Read-Write error message?
Replies
9
Views
268
Alex Blakenburg
A
FrumpyJones
  • Question Question
Is there a way to stop COPY/PASTE but still allow manual entries and use of drop down lists.
Replies
5
Views
253
FrumpyJones
FrumpyJones
M
  • Solved
VBA - For Cycle with "On Error" not working on the second iteration
Replies
9
Views
149
Joe4
Joe4
Skyybot
  • Solved
Excel VBA - Run Time Error
Replies
1
Views
90
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,888
Messages
6,175,217
Members
452,619
Latest member
Shiv1198

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