Help with existing code that isn't working

D

danbates77

Board Regular
Joined
Jan 10, 2017
Messages
52
Office Version
  1. 2016
Hi,

Please can someone help me?

I have the following code which was working fine on last years workbook but for some reason at the start of this year it hasn't worked.

The workbooks are identical apart from the dates and because the code doesn't error I was hoping someone could explain the best they can to me what exactly is happening?

I have checked both codes against each other and they are the same.

Here is the code:
VBA Code: 
ThisWorkbook.Worksheets("WEEKLY").Select

Dim lrSCA, lrSCB, lrTBA, lrWA, lrWB, lrEPT, lrFPT, lrMPA1, lrMPA2, lrMPB1, lrMPB2 As Long
'    Dim vCol

'-----------------------------------------------------------------------------------------
'SHUTTLE CAR A
'-----------------------------------------------------------------------------------------

Dim xRowSCA As Long



lrSCA = Sheets("WEEKLY").Range("P6").SpecialCells(xlCellTypeLastCell).Row


For xRowSCA = lrSCA To 6 Step -1   '6 is the first row with data

    If cells(xRowSCA, "P") <> "" And cells(xRowSCA, "P") <> "N/A" And cells(xRowSCA, "C") = "A" Then
        cells(xRowSCA, "P").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsSCA.Caption = .Value
 LabelInitialsSCA.BackColor = vCol
 End With

STATSFORM.LabelDateSCA.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeSCA.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowSCA

and when I run through the code via F8, it gets to this line and then skips onto the next section of the code.

Row 6 is the first row which could possible have some data.

VBA Code: 
For xRowSCA = lrSCA To 6 Step -1   '6 is the first row with data

Any help would be appreciated.

Thanks

Dan
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Hi,

After looking at my code further I noticed someone has added the following code:
VBA Code: 
On Error Resume Next

This will explain why my code wasn't coming up with an error. I have removed this line and now I get the following error:

Run-time error 1004: Unable to get the SpecialCells property of the range class

and it highlights this line:
VBA Code: 
lrSCA = Sheets("WEEKLY").Range("P6").SpecialCells(xlCellTypeLastCell).Row

Any further help would be appreciated.

Thanks
Dan
 
Upvote 0
You're interested in finding the last row then try this instead.

VBA Code: 
lrsca = Sheets("WEEKLY").Range("P" & Rows.Count).End(xlUp).Row
 
Upvote 0
Hi,

Your code has worked for the shuttle car A part of my code and I copied your code changing the column letters to suit but now I am getting the following error message on the same line but on the shuttle car B:

Run-time error 1004: Application-defined or object-defined error

VBA Code: 
Private Sub UserForm_Activate()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

UnprotectAllWorksheets

    Dim myRGB_Red As Long:      myRGB_Red = RGB(255, 0, 0)
    Dim myRGB_Blue As Long:     myRGB_Blue = RGB(0, 112, 192)
    Dim myRGB_Green As Long:    myRGB_Green = RGB(0, 176, 80)
    Dim myRGB_Yellow As Long:   myRGB_Yellow = RGB(255, 255, 0)

ThisWorkbook.Worksheets("WEEKLY").Select

Dim lrSCA, lrSCB, lrTBA, lrWA, lrWB, lrEPT, lrFPT, lrMPA1, lrMPA2, lrMPB1, lrMPB2 As Long
Dim vCol
'-----------------------------------------------------------------------------------------
'SHUTTLE CAR A
'-----------------------------------------------------------------------------------------

Dim xRowSCA As Long



'lrSCA = Sheets("WEEKLY").Range("P6").SpecialCells(xlCellTypeLastCell).Row
lrSCA = Sheets("WEEKLY").Range("P" & Rows.Count).End(xlUp).Row

For xRowSCA = lrSCA To 6 Step -1   '6 is the first row with data

    If cells(xRowSCA, "P") <> "" And cells(xRowSCA, "P") <> "N/A" And cells(xRowSCA, "C") = "A" Then
        cells(xRowSCA, "P").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsSCA.Caption = .Value
 LabelInitialsSCA.BackColor = vCol
 End With

STATSFORM.LabelDateSCA.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeSCA.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowSCA

'--------------------------------------------------------------------------
'SHUTTLE CAR B
'--------------------------------------------------------------------------

Dim xRowSCB As Long

'lrSCB = Sheets("WEEKLY").Range("P6").SpecialCells(xlCellTypeLastCell).Row
lrSCB = Sheets("WEEKLY").Range("P6" & Rows.Count).End(xlUp).Row

For xRowSCB = lrSCB To 6 Step -1   '6 is the first row with data

    If cells(xRowSCB, "P") <> "" And cells(xRowSCB, "P") <> "N/A" And cells(xRowSCB, "C") = "B" Then
        cells(xRowSCB, "P").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsSCB.Caption = .Value
 LabelInitialsSCB.BackColor = vCol
 End With

STATSFORM.LabelDateSCB.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeSCB.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowSCB

'-----------------------------------------------------------------------------------
'WRAPPER A
'-----------------------------------------------------------------------------------

Dim xRowWA As Long

'lrWA = Sheets("WEEKLY").Range("BE6").SpecialCells(xlCellTypeLastCell).Row
lrWA = Sheets("WEEKLY").Range("BE6" & Rows.Count).End(xlUp).Row

For xRowWA = lrWA To 6 Step -1   '6 is the first row with data

    If cells(xRowWA, "BE") <> "" And cells(xRowWA, "BE") <> "N/A" And cells(xRowWA, "AJ") = "A" Then
        cells(xRowWA, "BE").Select

 Select Case ActiveCell
                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue
 End Select

 With ActiveCell
 LabelInitialsWA.Caption = .Value
 LabelInitialsWA.BackColor = vCol
 End With

STATSFORM.LabelDateWA.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeWA.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowWA

'--------------------------------------------------------------------------
'WRAPPER B
'--------------------------------------------------------------------------

Dim xRowWB As Long

'lrWB = Sheets("WEEKLY").Range("BE6").SpecialCells(xlCellTypeLastCell).Row
lrWB = Sheets("WEEKLY").Range("BE6" & Rows.Count).End(xlUp).Row

For xRowWB = lrWB To 6 Step -1   '6 is the first row with data

    If cells(xRowWB, "BE") <> "" And cells(xRowWB, "BE") <> "N/A" And cells(xRowWB, "AJ") = "B" Then
        cells(xRowWB, "BE").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue
 End Select

 With ActiveCell
 LabelInitialsWB.Caption = .Value
 LabelInitialsWB.BackColor = vCol
 End With

STATSFORM.LabelDateWB.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeWB.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowWB

'---------------------------------------------------------------------------------------
'FPT
'---------------------------------------------------------------------------------------

Dim xRowFPT As Long

'lrFPT = Sheets("WEEKLY").Range("CN6").SpecialCells(xlCellTypeLastCell).Row
lrFPT = Sheets("WEEKLY").Range("CN6" & Rows.Count).End(xlUp).Row

For xRowFPT = lrFPT To 6 Step -1   '6 is the first row with data

    If cells(xRowFPT, "CN") <> "" And cells(xRowFPT, "CN") <> "N/A" Then
        cells(xRowFPT, "CN").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsFPT.Caption = .Value
 LabelInitialsFPT.BackColor = vCol
 End With

STATSFORM.LabelDateFPT.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeFPT.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowFPT

'------------------------------------------------------------------------------------
'EPT
'------------------------------------------------------------------------------------

Dim xRowEPT As Long

'lrEPT = Sheets("WEEKLY").Range("BW6").SpecialCells(xlCellTypeLastCell).Row
lrEPT = Sheets("WEEKLY").Range("BW6" & Rows.Count).End(xlUp).Row

For xRowEPT = lrEPT To 6 Step -1   '6 is the first row with data

    If cells(xRowEPT, "BW") <> "" And cells(xRowEPT, "BW") <> "N/A" Then
        cells(xRowEPT, "BW").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue
 End Select

 With ActiveCell
 LabelInitialsEPT.Caption = .Value
 LabelInitialsEPT.BackColor = vCol
 End With

STATSFORM.LabelDateEPT.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeEPT.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowEPT


'------------------------------------------------------------------------------------
'TBA
'------------------------------------------------------------------------------------

Dim xRowTBA As Long

'lrTBA = Sheets("WEEKLY").Range("AG6").SpecialCells(xlCellTypeLastCell).Row
lrTBA = Sheets("WEEKLY").Range("AG6" & Rows.Count).End(xlUp).Row

For xRowTBA = lrTBA To 6 Step -1   '6 is the first row with data

    If cells(xRowTBA, "AG") <> "" And cells(xRowTBA, "AG") <> "N/A" Then
        cells(xRowTBA, "AG").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsTBA.Caption = .Value
 LabelInitialsTBA.BackColor = vCol
 End With

STATSFORM.LabelDateTBA.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeTBA.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowTBA


'------------------------------------------------------------------------------------
'MARKEM PRINTERS
'------------------------------------------------------------------------------------

Dim xRowMPA1 As Long

'lrMPA1 = Sheets("WEEKLY").Range("DC6").SpecialCells(xlCellTypeLastCell).Row
lrMPA1 = Sheets("WEEKLY").Range("DC6" & Rows.Count).End(xlUp).Row

For xRowMPA1 = lrMPA1 To 6 Step -1   '6 is the first row with data

    If cells(xRowMPA1, "DC") <> "" And cells(xRowMPA1, "DC") <> "N/A" Then
        cells(xRowMPA1, "DC").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsMPA1.Caption = .Value
 LabelInitialsMPA1.BackColor = vCol
 End With

STATSFORM.LabelDateMPA1.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeMPA1.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowMPA1

'------------------------------------------------------------------------------------

Dim xRowMPA2 As Long

'lrMPA2 = Sheets("WEEKLY").Range("DR6").SpecialCells(xlCellTypeLastCell).Row
lrMPA2 = Sheets("WEEKLY").Range("DR6" & Rows.Count).End(xlUp).Row

For xRowMPA2 = lrMPA2 To 6 Step -1   '6 is the first row with data

    If cells(xRowMPA2, "DR") <> "" And cells(xRowMPA2, "DR") <> "N/A" Then
        cells(xRowMPA2, "DR").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsMPA2.Caption = .Value
 LabelInitialsMPA2.BackColor = vCol
 End With

STATSFORM.LabelDateMPA2.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeMPA2.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowMPA2

'------------------------------------------------------------------------------------

Dim xRowMPB1 As Long

'lrMPB1 = Sheets("WEEKLY").Range("EG6").SpecialCells(xlCellTypeLastCell).Row
lrMPB1 = Sheets("WEEKLY").Range("EG6" & Rows.Count).End(xlUp).Row

For xRowMPB1 = lrMPB1 To 6 Step -1   '6 is the first row with data

    If cells(xRowMPB1, "EG") <> "" And cells(xRowMPB1, "EG") <> "N/A" Then
        cells(xRowMPB1, "EG").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue

 End Select

 With ActiveCell
 LabelInitialsMPB1.Caption = .Value
 LabelInitialsMPB1.BackColor = vCol
 End With

STATSFORM.LabelDateMPB1.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeMPB1.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowMPB1

'------------------------------------------------------------------------------------

Dim xRowMPB2 As Long

'lrMPB2 = Sheets("WEEKLY").Range("EV6").SpecialCells(xlCellTypeLastCell).Row
lrMPB2 = Sheets("WEEKLY").Range("EV6" & Rows.Count).End(xlUp).Row

For xRowMPB2 = lrMPB2 To 6 Step -1   '6 is the first row with data

    If cells(xRowMPB2, "EV") <> "" And cells(xRowMPB2, "EV") <> "N/A" Then
        cells(xRowMPB2, "EV").Select

 Select Case ActiveCell

                    Case Is = "DB1", "AL1", "PD1", "MG1", "RT1", "DS1":                                    vCol = myRGB_Red
                    Case Is = "AS1", "MT1", "AM3", "KA1", "BL1", "LP1", "JS1", "SS1", "AW1":               vCol = myRGB_Yellow
                    Case Is = "RH1", "MC1", "MN1", "PP2", "MK1", "RL1", "JP1", "ML1", "JB1", "RW1":        vCol = myRGB_Green
                    Case Is = "GC1", "PP1", "DP1", "AP1", "HO1", "SM1":                                    vCol = myRGB_Blue
 End Select

 With ActiveCell
 LabelInitialsMPB2.Caption = .Value
 LabelInitialsMPB2.BackColor = vCol
 End With

STATSFORM.LabelDateMPB2.Caption = ActiveCell.Offset(0, 1).Text
STATSFORM.LabelTimeMPB2.Caption = ActiveCell.Offset(0, 2).Text

        Exit For
    End If

Next xRowMPB2
 
ProtectAllWorksheets

Application.ScreenUpdating = True
Application.DisplayAlerts = True
aaaaaLockandProtect

End Sub

I appreciate I should of shown all my code to start with but I though if we could get the first part working, then all the others would follow. My mistake, sorry.

I would appreciate any further help.

Thanks

Dan
 
Upvote 0
Change this line
from

VBA Code: 
lrSCB = Sheets("WEEKLY").Range("P6" & Rows.Count).End(xlUp).Row

to
VBA Code: 
lrSCB=Sheets("WEEKLY").Range("P" & Rows.Count).End(xlUp).Row
 
Upvote 0
Solution
Hi,

I am such an idiot at times, can't believe I didn't spot it lol

Thank you so much for your help.

Do you know why special cells line of code stopped working?

Thanks again

Dan
 
Upvote 0
danbates77 said:
Hi,

I am such an idiot at times, can't believe I didn't spot it lol

Thank you so much for your help.

Do you know why special cells line of code stopped working?

Thanks again

Dan
Click to expand...
The xltypelastcell doesn't work on the last row, it works on the largest cell that you typed in the sheet. It doesn't matter if you have typed in that cell and removed it, Excel will still remember it. so go to a new sheet and type in the 10000 th row and delete the words from the cell and use

VBA Code: 
MsgBox Sheet1.Range("A1").SpecialCells(xlCellTypeLastCell).Row

it will still show the last row as 10000th despite not having any data in it.

I cannot tell the exact reason why it happened without the sheet. Maybe the container is not big enough to store the value.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA to find last entry, check col C then fills out userform labels accordingly.
Replies
0
Views
280
danbates
D

Forum statistics

Threads
1,224,825
Messages
6,181,190
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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