Error trapping for dynamic array

[Dr. Demento]

I'm extraordinarily dense today because I can't figure out how to include error handling when creating a dynamic array that may be empty. The primary project is separating data onto individual sheets; I'm using hiker95's solution found here - awesome work, btw. However, since my arrays can be empty, I need error handling.

There's a multitude of error handling solutions found here, but I have two problems:

1. I don't know how to implement the handling into hiker95's code
2. I don't know which SO solution would be the most universal (GSerg's seems to have limits with string arrays, others only capture Variant arrays, etc).

Any assistance from the Collective would be most welcome.

 

[hiker95]

I'm using hiker95's solution found here - awesome work, btw.

Dr. Demento,

Thanks for the kudos.


1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

3. Can we see your macro code?

When posting VBA code, please use Code Tags - like this:

[code=rich]

'Paste your code here.

[/code]


To start off, and, so that we can get it right on the first try:

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post a small screen shot (NOT a graphic, or, picture, or, PNG file, or, flat text) try one of the following:

MrExcel HTML Maker
If you do not know how to install and how to use HTML Mr.Excel Maker
https://www.youtube.com/watch?v=JycvgGppxt0&feature=youtu.be

Excel Jeanie
Download

Borders-Copy-Paste
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045

To test the above:
Test Here


The following is a free site:

Or, you can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[Dr. Demento]

Hiker95,

Thanks for the assist; it is very much appreciated and will definitely help expand my repetoir!!


1. What version of Excel, and, Windows are you using? Windows 7; Excel 2010
2. Are you using a PC or a Mac? PC
3. Can we see your macro code? As you wish . . .

Option Explicit
Option Base 1

Sub DisributeRowsArrays()
' ~~ VBA - Copy and paste entire row to destination sheets based on cell value
' hiker95, 02/14/2014
' http://www.mrexcel.com/forum/excel-questions/685493-visual-basic-applications-move-rows-another-sheet-based-criteria-2.html#18

  Dim shtSRC As Worksheet
  Set shtSRC = ThisWorkbook.Worksheets("SRC_Weekly")
  
  Dim shtSA As Worksheet, shtSAF As Worksheet
  Dim shtSMC As Worksheet, shtSN As Worksheet
  Set shtSA = Worksheets("SA_Weekly")
  Set shtSAF = Worksheets("SAF_Weekly")
  Set shtSMC = Worksheets("SMC_Weekly")
  Set shtSN = Worksheets("SN_Weekly")
  
  Dim arrSRC As Variant  ' ~~ each group has its own array (incl master sht - "SRC_Weekly")
  Dim arrA As Variant, arrF As Variant
  Dim arrM As Variant, arrN As Variant

  Dim aa As Integer, ff As Integer
  Dim mm As Integer, nn As Integer
  
  Dim cntr As Integer
  Dim col As Integer
  Dim LastColumn As Integer
  Dim LastRow As Integer

  shtSRC.Cells.WrapText = False 'Stop Text Wrapping
  shtSA.Rows("3:100").Clear
  shtSAF.Rows("3:100").Clear
  shtSMC.Rows("3:100").Clear
  shtSN.Rows("3:100").Clear
  
  LastColumn = 8
  '################   CAN IGNORE THIS SECTION   ##############################
  ' ~~ Attempt to autocount used columns, but need to exclude any data in rows(1:2)
  ' ~~ Count last column in shtSRC, omitting header 2 rows || _
    [url=http://strugglingtoexcel.com/2014/05/26/actual-used-range-excel-vba/]Get the Actual Used Range in a Spreadsheet | Struggling To Excel[/url] _
    [url=http://stackoverflow.com/questions/9918785/excel-omitting-rows-columns-from-vba-macro]Excel: Omitting rows/columns from VBA macro - Stack Overflow[/url]
'  LastColumn = ActualUsedRange(shtSRC).Cells(1).Offset(2, 0).Resize(ActualUsedRange(shtSRC).Rows.Count - 2, ActualUsedRange(shtSRC).Columns.Count)
'  MsgBox LastColumn.Value
  
  ' [url]http://www.mrexcel.com/forum/excel-questions/619875-exclude-rows-usedrange.html[/url]
'  Set arrSRC = Application.Intersect(ActualUsedRange(shtSRC), ActualUsedRange(shtSRC).Cells.Resize(Rows.Count - 2).Offset(2))
'  LastColumn = arrSRC.Columns.Count
  '#######################################################
  


' #####>>>>>  ERROR HANDLING - THIS SECTION <<<<<#####

  If shtSRC.FilterMode Then shtSRC.ShowAllData
    arrSRC = shtSRC.Range("A3").CurrentRegion.Resize(, LastColumn)  ' ~~ start reading in row 3 (after header), using 8 columns
    cntr = Application.CountIf(shtSRC.Columns(4), "SA")  ' ~~ col 4 = group
    ReDim arrA(1 To cntr, 1 To LastColumn) '~~ chk for empty arrays & redim || [url=http://www.vbforums.com/showthread.php?372419-EXCEL-VBA-How-To-Deal-with-Empty-Dynamic-Arrays#2]EXCEL VBA: How To: Deal with Empty Dynamic Arrays ???-VBForums[/url]
    cntr = Application.CountIf(shtSRC.Columns(4), "SAF")
    ReDim arrF(1 To cntr, 1 To LastColumn)
    cntr = Application.CountIf(shtSRC.Columns(4), "SMC")
    ReDim arrM(1 To cntr, 1 To LastColumn)
    cntr = Application.CountIf(shtSRC.Columns(4), "SN")
    ReDim arrN(1 To cntr, 1 To LastColumn)
    
    
    For cntr = 1 To UBound(arrSRC, 1)
      If arrSRC(cntr, 4) = "SA" Then
        aa = aa + 1
        For col = 1 To LastColumn
          arrA(aa, col) = arrSRC(cntr, col)
        Next col
        
        'original coding || traded in for for loops
'        arrA(aa, 1) = arrSRC(cntr, 1)
'        arrA(aa, 2) = arrSRC(cntr, 2)
'        arrA(aa, 3) = arrSRC(cntr, 3)
'        arrA(aa, 4) = arrSRC(cntr, 4)
'        arrA(aa, 5) = arrSRC(cntr, 5)
'        arrA(aa, 6) = arrSRC(cntr, 6)
'        arrA(aa, 7) = arrSRC(cntr, 7)
'        arrA(aa, 8) = arrSRC(cntr, 8)

      ElseIf arrSRC(cntr, 4) = "SAF" Then
        ff = ff + 1
        For col = 1 To LastColumn
          arrF(ff, col) = arrSRC(cntr, col)
        Next col
        
      ElseIf arrSRC(cntr, 4) = "SMC" Then
        mm = mm + 1
        For col = 1 To LastColumn
          arrM(mm, col) = arrSRC(cntr, col)
        Next col

      ElseIf arrSRC(cntr, 4) = "SN" Then
        nn = nn + 1
        For col = 1 To LastColumn
          arrN(nn, col) = arrSRC(cntr, col)
        Next col
        
      End If
    Next cntr
  
  LastRow = shtSA.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    shtSA.Range("A" & LastRow).Resize(UBound(arrA, 1), LastColumn) = arrA
  LastRow = shtSAF.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    shtSAF.Range("A" & LastRow).Resize(UBound(arrF, 1), LastColumn) = arrF
  LastRow = shtSMC.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    shtSMC.Range("A" & LastRow).Resize(UBound(arrM, 1), LastColumn) = arrM
  LastRow = shtSN.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    shtSN.Range("A" & LastRow).Resize(UBound(arrN, 1), LastColumn) = arrN

End Sub

The workbook can be found here: https://drive.google.com/file/d/0B3Eqczl1SQF3b0RnUTk3SnpqbFU/view?usp=sharing

The SRC_Weekly is the master sheet which populates the other four sheets.
The data is separated according to the value in col D - four possible values to four sheets.
The data on SRC_Weekly works when there are all four values in col D; however, if you delete the last entry (row 14, Svc = SMC), the data goes sideways on SMC_Weekly and SN_Weekly.

The main thrust of this exercise is to develop efficient code to separate data; my specific question is how to apply error handling for arrays that may be empty and yet the code may have broad applicability (with tweaking, of course).

Also, if you can give me some pointers about how to ensure that col A (SSN) gets applied to the destination worksheets as Text format instead of General or Number, I would be most appreciative. I can re-post separately if you think that would be appropriate.

Thanks again for the solid framework and the finishing touches. Because of generous folks like you, noobs like me make headway into this brave new world.

Dr. D

 

[hiker95]

Dr. Demento,

Thanks for the workbook.

I have had a problem in the past when downloading/opening an Excel file with the file extension xlsm.

Please save the workbook as an xlsx file, and, re-post again on google.

 

[Drrellik]

I used to listen to the Dr. Demento Show on KBPI FM 106.7 in Denver Colorado many years ago. cool name.

~DR

 

[Dr. Demento]

Good to know for future reference.

Here's the .xlsx file: https://drive.google.com/file/d/0B3Eqczl1SQF3X1o5c09HSWFsZFU/view?usp=sharing

 

[Dr. Demento]

Fish heads -- still an all time favorite


`•.¸¸.•´><((((º>`•.¸¸.•´¯`•.¸.•´¯`•...¸><((((º>
Fish heads, fish heads, roly poly fish heads
Fish heads, fish heads, eat them up --- Yumm!
<º))))>< ...¸•´¯`•.¸.•´¯`•.¸.•´<º))))><`•.¸¸.•´

 

[Dr. Demento]

Dr. Demento,

Thanks for the workbook.

I have had a problem in the past when downloading/opening an Excel file with the file extension xlsm.

Please save the workbook as an xlsx file, and, re-post again on google.

Hiker95,

Sorry - I realized that I didn't respond directly to your quote, so you might not have been notified that I uploaded the .xlsx to GDrive. If you were aware, please ignore this

File: link

 

[hiker95]

Dr. Demento,

Thanks for the workbook.

Because of something in the actual workbook that was giving me a message every once in a while, I had to copy each worksheet into a new workbook.

I do not see the benefit of using arrays to resolve your request, unless I do not understand what you are actually trying to do.

Here is a macro solution for you to consider.

To start off worksheets SA_Weekly, SAF_Weekly, SMC_Weekly, and, SN_Weekly, only contain titles in range A1:H2.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	K	L	M	N	O
1	For week ending 08/09/2015								Total: 12	SA: 5	SAF: 4	SMC: 1	SN: 2
2	SSN	Lname	Fname	Svc	Cmp	Date	Confo	Circ	S: 6	sp: 6	Other: 0
3	000000001	a	a	SA	A	6/22/2015	S
4	000000002	b	b	SA	G	7/4/2015	S
5	000000003	a	c	SA	V	7/31/2015	S
6	000000004	a	d	SA	A	7/30/2015	SP
7	000000005	b	e	SA	G	7/31/2015	SP
8	000000006	a	f	SAF	V	7/30/2015	S
9	000000007	a	g	SAF	A	8/1/2015	S
10	000000008	b	h	SAF	G	7/29/2015	SP
11	000000009	a	i	SAF	V	8/2/2015	SP
12	000000010	a	j	SN	A	7/30/2015	S
13	000000011	b	k	SN	V	8/1/2015	SP
14	000000012	a	l	SMC	V	8/1/2015	SP
15
SRC_Weekly

Cell Formulas
Range	Formula
K1	="Total: "& COUNTA($A:$A)-2
K2	="S: "&COUNTIF($G:$G, "S")
L1	="SA: "& COUNTIF($D:$D, "SA")
L2	="sp: "&COUNTIF($G:$G, "sp")
M1	="SAF: "& COUNTIF($D:$D, "SAF")
M2	="Other: "&SUM(COUNTIF($G:$G, "A"), COUNTIF($G:$G, "N"), COUNTIF($G:$G, "H"), COUNTIF($G:$G, "U"))
N1	="SMC: "& COUNTIF($D:$D, "SMC")
O1	="SN: "& COUNTIF($D:$D, "SN")

After the macro in a few of the worksheets:

Excel 2007
	A	B	C	D	E	F	G	H
1	For week ending 08/09/2015
2	SSN	Lname	Fname	Svc	Cmp	Date	Confo	Circ
3	000000001	a	a	SA	A	6/22/2015	S
4	000000002	b	b	SA	G	7/4/2015	S
5	000000003	a	c	SA	V	7/31/2015	S
6	000000004	a	d	SA	A	7/30/2015	SP
7	000000005	b	e	SA	G	7/31/2015	SP
8
SA_Weekly

Excel 2007
	A	B	C	D	E	F	G	H
1	For week ending 08/09/2015
2	SSN	Lname	Fname	Svc	Cmp	Date	Confo	Circ
3	000000012	a	l	SMC	V	8/1/2015	SP
4
SMC_Weekly

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub Distribute_SRC_Weekly()
' hiker95, 08/13/2015, ME874631
Dim wsrc As Worksheet, wsa As Worksheet, wsaf As Worksheet, wsmc As Worksheet, wsn As Worksheet
Dim c As Range, nr As Long, n As Long
Application.ScreenUpdating = False
Set wsrc = Sheets("SRC_Weekly")
Set wsa = Sheets("SA_Weekly")
Set wsaf = Sheets("SAF_Weekly")
Set wsmc = Sheets("SMC_Weekly")
Set wsn = Sheets("SN_Weekly")
n = 0
With wsrc
  .Activate
  For Each c In .Range("D3", .Range("D" & Rows.Count).End(xlUp))
    If Not c = vbEmpty Then
      If c = "SA" Then
        nr = wsa.Cells(wsa.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsa.Range("A" & nr)
        wsa.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SAF" Then
        nr = wsaf.Cells(wsaf.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsaf.Range("A" & nr)
        wsaf.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SMC" Then
        nr = wsmc.Cells(wsmc.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsmc.Range("A" & nr)
        wsmc.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SN" Then
        nr = wsn.Cells(wsn.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsn.Range("A" & nr)
        wsn.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      End If
    End If
    If n = 10 Then
      Application.CutCopyMode = False
      n = 0
    End If
  Next c
  wsa.Columns("A:H").AutoFit
  wsaf.Columns("A:H").AutoFit
  wsmc.Columns("A:H").AutoFit
  wsn.Columns("A:H").AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the Distribute_SRC_Weekly macro.

 

[hiker95]

Dr. Demento,

I finally went thru the macro that you provided.

  shtSA.Rows("3:100").Clear
  shtSAF.Rows("3:100").Clear
  shtSMC.Rows("3:100").Clear
  shtSN.Rows("3:100").Clear

It would appear that each of the above worksheets will never have more than 98 rows of copied data from worksheet SRC_Weekly, so the use of arrays does not make sense to me.

Here is another macro solution for you to consider that does not use arrays.

And, it clears Rows("3:100").Clear of the other four worksheets.

And, it checks if worksheet SRC_Weekly is filtered. If .FilterMode = True Then .ShowAllData


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub Distribute_SRC_Weekly_V2()
' hiker95, 08/13/2015, ME874631
Dim wsrc As Worksheet, wsa As Worksheet, wsaf As Worksheet, wsmc As Worksheet, wsn As Worksheet
Dim c As Range, nr As Long, n As Long
Application.ScreenUpdating = False
Set wsrc = Sheets("SRC_Weekly")
Set wsa = Sheets("SA_Weekly")
Set wsaf = Sheets("SAF_Weekly")
Set wsmc = Sheets("SMC_Weekly")
Set wsn = Sheets("SN_Weekly")
wsa.Range("A3:H100").Clear
wsaf.Range("A3:H100").Clear
wsmc.Range("A3:H100").Clear
wsn.Range("A3:H100").Clear
n = 0
With wsrc
  .Activate
  .UsedRange.Cells.WrapText = False
  If .FilterMode = True Then .ShowAllData
  For Each c In .Range("D3", .Range("D" & Rows.Count).End(xlUp))
    If Not c = vbEmpty Then
      If c = "SA" Then
        nr = wsa.Cells(wsa.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsa.Range("A" & nr)
        wsa.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SAF" Then
        nr = wsaf.Cells(wsaf.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsaf.Range("A" & nr)
        wsaf.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SMC" Then
        nr = wsmc.Cells(wsmc.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsmc.Range("A" & nr)
        wsmc.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      ElseIf c = "SN" Then
        nr = wsn.Cells(wsn.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & c.Row).Resize(, 8).Copy wsn.Range("A" & nr)
        wsn.Range("F" & nr).NumberFormat = "m/d/yyyy"
        n = n + 1
      End If
    End If
    If n = 10 Then
      Application.CutCopyMode = False
      n = 0
    End If
  Next c
  wsa.Columns("A:H").AutoFit
  wsaf.Columns("A:H").AutoFit
  wsmc.Columns("A:H").AutoFit
  wsn.Columns("A:H").AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the Distribute_SRC_Weekly_V2 macro.