Excel/vba code

mkostas66

New Member
Joined
Oct 17, 2022
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi!

I have the following code. It supposed to copy certain cells to a new book.
If i run the code in VBA with F5 it's working but when i hit the button with the code in the excel i get 0 copies.

Any ideas what's wrong?

VBA Code:
Sub UpdateActionPlan()

Dim intAdded As Integer, intSRow, intTRow
Dim sngRecord(6)
Dim strTFullPath As String
Dim strText As String
Dim strResponse As VbMsgBoxResult
Dim cancel As Integer
Dim strFileName As String
Dim i As Integer
Dim LastRow As Integer
Dim FirstRow As Integer

FirstRow = 7
LastRow = 1000
i = FirstRow


strFileName = “Test.xls”
strTFullPath = strFileName
Workbooks.Open filename:=strTFullPath

Do Until i > LastRow
If Range("I" & i).Value = "Action" Then
 sngRecord(0) = Range("C" & i).Value
 sngRecord(1) = Range("G" & i).Value
 sngRecord(2) = Range("N" & i).Value
 sngRecord(3) = Range("O" & i).Value
 sngRecord(4) = Range("P" & i).Value
 sngRecord(5) = Range("T6").Value

 With Workbooks("Test.xlsx").Worksheets("CheckSheet")
       intTRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      .Range("C" & intTRow) = sngRecord(0)
      .Range("E" & intTRow) = sngRecord(1)
      .Range("G" & intTRow) = sngRecord(2)
      .Range("A" & intTRow) = sngRecord(3)
      .Range("D" & intTRow) = sngRecord(4)
     .Range("B" & intTRow) = sngRecord(5)
 End With
Else
 Cancel = True
End If

i = i + 1
Loop

End Sub
 
Since we are all just grabbing as straws here- what does the "CommandButton_Click" sub look like and where is it located....
 
Upvote 0

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
This may sound stupid but are you sure that the button and using F5 are executing the same code. On my machine because I have "Option Explicit" enabled, your code when copied to my VBE will not compile due to the quote marks that surround this line
VBA Code:
 strFileName = “Test.xlsx”
it is because the quote marks are not straight quote marks, they are the curly type (don't ask me to explain that). Retype that line with straight quote marks. If that does not make sense to you then add Option Explicit to your code and see what happens. I will recopy below. Copy this code to your machine and see it will run... Make sure you pick up "Option Explicit" when you copy.

VBA Code:
Option Explicit

Sub UpdateActionPlan()

    Dim intAdded As Integer, intSRow, intTRow
    Dim sngRecord(6)
    Dim strTFullPath As String
    Dim strText As String
    Dim strResponse As VbMsgBoxResult
    Dim cancel As Integer
    Dim strFileName As String
    Dim i As Integer
    Dim LastRow As Integer
    Dim FirstRow As Integer


    FirstRow = 7
    LastRow = 1000
    i = FirstRow


    strFileName = “Test.xlsx”
    strTFullPath = strFileName
    Workbooks.Open Filename:=strTFullPath

    Do Until i > LastRow
        If Range("I" & i).Value = "Action" Then
            sngRecord(0) = Range("C" & i).Value
            sngRecord(1) = Range("G" & i).Value
            sngRecord(2) = Range("N" & i).Value
            sngRecord(3) = Range("O" & i).Value
            sngRecord(4) = Range("P" & i).Value
            sngRecord(5) = Range("T6").Value
    
            With Workbooks("Test.xlsx").Worksheets("CheckSheet")
                  intTRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                 .Range("C" & intTRow) = sngRecord(0)
                 .Range("E" & intTRow) = sngRecord(1)
                 .Range("G" & intTRow) = sngRecord(2)
                 .Range("A" & intTRow) = sngRecord(3)
                 .Range("D" & intTRow) = sngRecord(4)
                .Range("B" & intTRow) = sngRecord(5)
            End With
        Else
            cancel = True
        End If
    
        i = i + 1
    Loop

End Sub
 
Upvote 0
@igold the slanted quotes lead to a runtime error when option explicit is absent and lead to a compile error when its there. So I think that cannot be the cause.

NB: This code should work the same as yours:

VBA Code:
Option Explicit

Sub UpdateActionPlan()
    Dim intTRow As Long
    Dim strFileName As String
    Dim i As Integer
    Dim ValOfT6 As Variant 'The value of cell T6, change to a better name

    strFileName = "Test.xlsx"
    Workbooks.Open Filename:=strFileName
    ValOfT6 = Range("T6").Value
    For i = 7 To 1000
        If Range("I" & i).Value = "Action" Then
            With Workbooks("Test.xlsx").Worksheets("CheckSheet")
                intTRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                .Range("C" & intTRow) = Range("C" & i).Value
                .Range("E" & intTRow) = Range("G" & i).Value
                .Range("G" & intTRow) = Range("N" & i).Value
                .Range("A" & intTRow) = Range("O" & i).Value
                .Range("D" & intTRow) = Range("P" & i).Value
                .Range("B" & intTRow) = ValOfT6
            End With
        End If
    Next
End Sub
 
Upvote 0
@igold the slanted quotes lead to a runtime error when option explicit is absent and lead to a compile error when its there. So I think that cannot be the cause.

NB: This code should work the same as yours:

VBA Code:
Option Explicit

Sub UpdateActionPlan()
    Dim intTRow As Long
    Dim strFileName As String
    Dim i As Integer
    Dim ValOfT6 As Variant 'The value of cell T6, change to a better name

    strFileName = "Test.xlsx"
    Workbooks.Open Filename:=strFileName
    ValOfT6 = Range("T6").Value
    For i = 7 To 1000
        If Range("I" & i).Value = "Action" Then
            With Workbooks("Test.xlsx").Worksheets("CheckSheet")
                intTRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                .Range("C" & intTRow) = Range("C" & i).Value
                .Range("E" & intTRow) = Range("G" & i).Value
                .Range("G" & intTRow) = Range("N" & i).Value
                .Range("A" & intTRow) = Range("O" & i).Value
                .Range("D" & intTRow) = Range("P" & i).Value
                .Range("B" & intTRow) = ValOfT6
            End With
        End If
    Next
End Sub
I got the exact same results as my code. I've also tried by changing the condition If Range("I" & i).Value = "Action" to <> "" or >0 but still nothing happens.
There are also no compilation errors in any code.
 
Upvote 0
This may sound stupid but are you sure that the button and using F5 are executing the same code. On my machine because I have "Option Explicit" enabled, your code when copied to my VBE will not compile due to the quote marks that surround this line
VBA Code:
 strFileName = “Test.xlsx”
it is because the quote marks are not straight quote marks, they are the curly type (don't ask me to explain that). Retype that line with straight quote marks. If that does not make sense to you then add Option Explicit to your code and see what happens. I will recopy below. Copy this code to your machine and see it will run... Make sure you pick up "Option Explicit" when you copy.

VBA Code:
Option Explicit

Sub UpdateActionPlan()

    Dim intAdded As Integer, intSRow, intTRow
    Dim sngRecord(6)
    Dim strTFullPath As String
    Dim strText As String
    Dim strResponse As VbMsgBoxResult
    Dim cancel As Integer
    Dim strFileName As String
    Dim i As Integer
    Dim LastRow As Integer
    Dim FirstRow As Integer


    FirstRow = 7
    LastRow = 1000
    i = FirstRow


    strFileName = “Test.xlsx”
    strTFullPath = strFileName
    Workbooks.Open Filename:=strTFullPath

    Do Until i > LastRow
        If Range("I" & i).Value = "Action" Then
            sngRecord(0) = Range("C" & i).Value
            sngRecord(1) = Range("G" & i).Value
            sngRecord(2) = Range("N" & i).Value
            sngRecord(3) = Range("O" & i).Value
            sngRecord(4) = Range("P" & i).Value
            sngRecord(5) = Range("T6").Value
   
            With Workbooks("Test.xlsx").Worksheets("CheckSheet")
                  intTRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                 .Range("C" & intTRow) = sngRecord(0)
                 .Range("E" & intTRow) = sngRecord(1)
                 .Range("G" & intTRow) = sngRecord(2)
                 .Range("A" & intTRow) = sngRecord(3)
                 .Range("D" & intTRow) = sngRecord(4)
                .Range("B" & intTRow) = sngRecord(5)
            End With
        Else
            cancel = True
        End If
   
        i = i + 1
    Loop

End Sub
Sorry, same situation with or without open explicit
 
Upvote 0
@jkpieterse -
@igold the slanted quotes lead to a runtime error when option explicit is absent and lead to a compile error when its there. So I think that cannot be the cause.
Thanks for the information/clarification on this. Why isn't one of his problems a runtime error... Or would the code simply ignore it as written...
 
Upvote 0
Sorry, same situation with or without open explicit
That does not really make sense. With the slanted quotes the code should not compile and therefore you should be unable to run it. If you can't run it how do you get results?
 
Upvote 0
Have you got a demo workbook for us with anonymized data?
I'm sorry, xl2bb cannot be installed due to policy.

test.xlsx
ABCDEFGHIJKLM
1​
2​
Title
3​
Descr 1Area DesType1FSUseFS+Start DateFinish dateStatus


Data.xlsm (file contains the test button36_Click and the code from jkpieterse. (If it's easier, can i upload the files from wetrasnfer or any similar.)
1BCDEFGHIJKLMNOPQRST
2​
3​
4​
F1F2F3FSExtra dataUseF1+F2+F3+FS+
5​
6​
1. Dgr
7​
TypeUsage 1AreaDesc
8​
Test 1Test 1.100000Usage 1Test 1Accepted
9​
Test 1.25002502250000Use 10200250150000Usage 1Test 1
Action
10​
Test 1.300000Usage 1Test 1
Accepted
11​
Test 1.400000Usage 1Test 1
Accepted
12​
Test 1.55002502250000Use 10200250150000Usage 1Test 1
Action
13​
Test 1.600000Usage 1Test 1
Accepted
14​
Test 1.700000Usage 1Test 1
Accepted
15​
Test 1.800000Usage 1Test 1
Accepted
16​
Test 1.900000Usage 1Test 1
Accepted
17​
Test 1.1000000Usage 1Test 1
Accepted
18​
Test 2Test 2.100000Usage 1Test 2Accepted
19​
Test 2.210002502500000Use 3010002501250000Usage 1Test 2
Action
20​
Test 2.300000Usage 1Test 2Accepted
Accepted
21​
Test 2.400000Usage 1Test 2Accepted
Accepted
22​
Test 2.55002502250000Use 20200250150000Usage 1Test 2Action
23​
Test 2.600000Usage 1Test 2Accepted
Accepted
24​
Test 2.700000Usage 1Test 2Accepted
Accepted
25​
Test 2.800000Usage 1Test 2Accepted
Accepted
26​
Test 2.900000Usage 1Test 2Accepted
Accepted
27​
Test 2.1000000Usage 1Test 2Accepted
Accepted
 
Upvote 0

Forum statistics

Threads
1,215,006
Messages
6,122,665
Members
449,091
Latest member
peppernaut

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