VBA Array is empty after looping and putting cell

2019-07-26 23:20发布

I have a macro I'm working on and it's suppose to loop through and store a cell's value into the array if the cells value equals IN. For some reason the array is empty. I'm new to VBA and suspect I might not be retrieving the cells values properly. Below is my code any assistance is appreciated thanks in advance.

Note the excel sheet the macro is being ran on does in fact have content in those cells and several with the value IN.

    Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim newbook As Boolean 'Flag if new book was created correctly
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name


'Main Driver
Sub Main()
    WorkbookSize = size() 'Run function to get workbook size
    newbook = False
    Call create            'Run sub to create new workbook
    Call pull(WorkbookSize)              'Run sub to pull data
End Sub

'Get size of Worksheet
Function size() As Long
    size = Cells(Rows.Count, "A").End(xlUp).Row
End Function

'Create workbook
Sub create()
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With
End Sub

'pull data
Sub pull(size)
    Dim code() As Variant
    ReDim code(size - 1)
    For i = 1 To size
    'Check code column fo IN and Doctype column for 810
        If Cells(i, 17).Value = "IN" Then
            code(i) = Cells(i, 17).Value 'store in array
        End If
    Next i
     Call push(code)
End Sub

'push data to new workbook
Sub push(ByRef code() As Variant)
    activeBook = "TempEDX.xlsm"
    Workbooks(activeBook).Activate 'set new workbook as active book
    Dim txt As String
    For i = 1 To UBound(code)
        txt = txt & code(i) & vbCrLf
        'Cells(i + 1, 1).Value = code(i)
    Next i
    MsgBox txt
End Sub

2条回答
地球回转人心会变
2楼-- · 2019-07-27 00:01

i think you are not selecting the right sheet.

put a

Sheets("NAME_OF_SHEET").Select

before the for, like

Sub push(ByRef code() As Variant)
  activeBook = "TempEDX.xlsm"
  Workbooks(activeBook).Activate 'set new workbook as active book
  Dim txt As String

  Sheets("NAME_OF_SHEET").Select
  For i = 1 To UBound(code)
      txt = txt & code(i) & vbCrLf
      'Cells(i + 1, 1).Value = code(i)
  Next i
  MsgBox txt
End Sub

thanks

查看更多
太酷不给撩
3楼-- · 2019-07-27 00:21

You should fully qualify your calls to the Cells Property. Otherwise Cells uses the active workbook and worksheet. In your case, you've created a workbook before scanning in your pull method. So you're essentially looking at an empty worksheet.

Either create the new workbook AFTER you pull, or create a new Worksheet variable and set it at the beginning like:

dim currentWorksheet as Worksheet
set currentWorksheet = Activesheet

Then, you should pass currentWorksheet into the pull function and size function.

I would do something like this:

    Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim newbook As Boolean 'Flag if new book was created correctly
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name


'Main Driver
Sub Main()
    Dim currentWorksheet As Worksheet
    Set currentWorksheet = ActiveSheet

    WorkbookSize = size(currentWorksheet) 'Run function to get workbook size
    newbook = False
    Dim values()
    values = pull(currentWorksheet, WorkbookSize)               'Run sub to pull data
    push create(), values
End Sub

'Get size of Worksheet
Function size(sh As Worksheet) As Long
    size = sh.Cells(Rows.COUNT, "A").End(xlUp).row
End Function

'Create workbook
Function create() As Workbook
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With

    Set create = wb
End Function

'pull data
Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(size - 1)
    For i = 1 To size
    'Check code column fo IN and Doctype column for 810
        If pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(i-1) = pullFromSheet.Cells(i, 17).Value 'store in array
        End If
    Next i
    pull = code
End Function

'push data to new workbook
Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    Dim txt As String
    For i = 0 To UBound(code)
        txt = txt & code(i) & vbCrLf
        newSheet.Cells(i + 1, 1).Value = code(i)
    Next i
    MsgBox txt
    newSheet.Activate 'just to make your new sheet active for the user
End Sub

I moved the Push code outside of the pull code and also create functions instead of subs so you have good handles on the new objects you are creating.

查看更多
登录 后发表回答