Data Grab from Closed Workbooks - Cell Reference Bug?

S

SoCoMike

New Member
Joined
Apr 26, 2018
Messages
18
So I am attempting to pull a LOT of cells from closed workbooks in a folder, I know it works on a small scale.. but when I put in this many cells it doesn't.
Here is the code.

Code: 
Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Range
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
            i = 0
         For Each Rng In ws.Range("F2, F3, C3, C2, H7, G7, F7, E7, H8, G8, F8, E8, H9, G9, F9, E9, H10, G10, F10, E10, H11, G11, F11, E11, H16, G16, F16, E16, H17, G17, F17, E17, H18, G18, F18, E18, H19, G19, F19, E19, H25, G25, F25, E25, H26, G26, F26, E26, H27, G27, F27, E27, H28, G28, F28, E28, H29, G29, F29, E29, H34, G34, F34, E34, H35, G35, F35, E35, H36, G36, F36, E36, H37, G37, F37, E37, H38, G38, F38, E38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, G59, F59, E59, H60, G60, F60, E60,")
            i = i + 1
            .Cells(Lr, i).Value = Rng.Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub
 
Last edited by a moderator:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
I suspect that you have hit a limit of some sort. Try
Code: 
Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "F2,F3,C3,C2,H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,G36,F36,E36, H37, G37, F37, E37, H38, G38, F38, E38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, G59, F59, E59, H60, G60, F60, E60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub
 
Upvote 0
There's a limit of 255 characters for the address you can use with the Range property.
 
Upvote 0
Thanks guys, works like a charm!!
I did not know that, yeah it worked with like 20 characters before.. figured there must have been a limit of some sort.
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
In the interest of being able to pivot this data easier, I split the macro into two separate codes to be ran.
When I run the larger bulk of the code, it only goes through 29 files in the folder.. while the shorter version will process all 55 files.

Any ideas why?

Code for reference.
Code: 
Sub OpenFile()
[COLOR=#008080]   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets(1)
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H20,D20,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,D36, H37, D37, H38, D38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, D59, H60, D60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
End Sub[/COLOR]
 
Last edited by a moderator:
Upvote 0
Does it open all 55 files & only copy data from 29, or does it only open 29 files?

PS. When posting code please use code tags, the # icon in the reply window.
 
Upvote 0
For clarity's sake, this is the combined code right now.

Code: 
Option Explicit
Sub OpenFile()
   Dim sPath As String
   Dim sFil As String
   Dim strName As String
   Dim twbk As Workbook
   Dim owbk As Workbook
   Dim ws As Worksheet
   Dim Rng As Variant, rngstr As String
   Dim i As Long, Lr As Long
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits\"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets("Charted Data")
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "H7,G7,F7,E7,H8,G8,F8,E8,H9,G9,F9,E9,H10,G10,F10,E10,H11,G11,F11,E11,H16,G16,F16,E16,H17,G17,F17,E17,H18,G18,F18,E18,H19,G19,F19,E19,H20,D20,H25,G25,F25,E25,H26,G26,F26,E26,H27,G27,F27,E27,H28,G28,F28,E28,H29,G29,F29,E29,H34,G34,F34,E34,H35,G35,F35,E35,H36,D36, H37, D37, H38, D38, H43, G43, F43, E43, H44, G44, F44, E44, H50, G50, F50, E50, H51, G51, F51, E51, H52, G52, F52, E52, H53, G53, F53, E53, H54, G54, F54, E54, H59, D59, H60, D60"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
   
   Set twbk = ActiveWorkbook
   sPath = "Q:\SAFETY\Leadership Safety Audit\Solomon\2018\Training Lab\Audits\"
   sFil = Dir(sPath & "*.xls")
   Do While sFil <> ""
      strName = sPath & sFil
      Set owbk = Workbooks.Open(strName)
      Set ws = Sheets("Appendix A - LVO")
      With twbk.Sheets("Flatfile")
         Lr = .Range("A" & .Rows.Count).End(xlUp)(2).Row
         i = 0
         rngstr = "F2,F3,C3,C2"
         For Each Rng In Split(rngstr, ",")
            i = i + 1
            .Cells(Lr, i).Value = ws.Range(Rng).Value
         Next Rng
      End With
      owbk.Close False
      sFil = Dir
   Loop
   twbk.Save
   
End Sub
 
Upvote 0
At a guess F2 is blank in some of those files
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Excel VBA to delete rows from workbooks from specific data set
Replies
4
Views
1K
Chase_Luke
C
S
  • Question
More Specific Data-Pull Code
2
Replies
18
Views
980
Fluff
Fluff
B
  • Question
Open up workbooks from a list & match a cell value, then copy the data adjacent to that value.
Replies
4
Views
755
Bagsy
B
R
  • Question
VBA CountIFs Across Multiple Workbooks
Replies
6
Views
3K
DanteAmor
DanteAmor
5
  • Question
Data Extraction multiple Sheets & Multiple Cells
2 3
Replies
28
Views
2K
Fluff
Fluff

Forum statistics

Threads
1,215,443
Messages
6,124,890
Members
449,194
Latest member
JayEggleton

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