How to hide blank values in columns and export your data into separate workbooks based on the values in a column

[RB26DETT]

Hi all,
I have a work sheet that has roughly 400 rows of information ( over time it will grow ), There will be some columns that will have blank values.

I am looking for a solution that is one VBA code that Export data into separate workbooks and then hides blank values in columns for each workbook that is exported.

I have two examples of VBA code that I am using separately.
This first code does the following Export data into separate workbooks based on the values in a column and the second VBA code hides blank values in columns.



First code:

Option Explicit

Sub ExportData()
'Declare variables
Dim ArrayItem As Long
Dim ws As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range

'Set the worksheet to
Set ws = Sheets("Data")

'Set the save path for the files created
SavePath = Range("FolderPath")

'Set variables for the column we want to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ExportCriteria").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ExportCriteria").Value & "]]"

'Turn off screen updating to save runtime
Application.ScreenUpdating = False

'Create a temporary list of unique values from the column we want to
'separate our data based on
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("UniqueValues"), Unique:=True

'Sort our temporary list of unique values
ws.Range("UniqueValues").EntireColumn.Sort Key1:=ws.Range("UniqueValues").Offset(1, 0), _
    Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Add unique field values into an array
'ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("IV2:IV" & Rows.Count).SpecialCells(xlCellTypeConstants))
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(ws.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))

'Delete the temporary values
ws.Range("UniqueValues").EntireColumn.Clear


'Loop through our array of unique field values, copy paste into new workbooks and save
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
    ws.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
    Workbooks.Add
    Range("A1").PasteSpecial xlPasteAll
    Cells.Columns.AutoFit
    ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), "_Tab") & ".xlsx", 51
    ActiveWorkbook.Close False
    ws.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem

ws.AutoFilterMode = False
MsgBox "Hey UAR gurus - finished exporting!"
Application.ScreenUpdating = True
   
End Sub

------------------------------------------------------------
Second code:

Sub hidecols()
'************************************************************************************************
'*
'************************************************************************************************
Dim cNbr, rNbr, maxRows, maxCols As Integer
Dim cr As Range
Set cr = ActiveSheet.Cells.CurrentRegion
maxRows = UBound(cr.Value, 1) '* Rows
maxCols = UBound(cr.Value, 2) '* Columns
For cNbr = 5 To maxCols
For rNbr = 3 To maxRows
If Not isNothing(ActiveSheet.Cells(rNbr, cNbr)) Then Exit For
Next rNbr
If rNbr = maxRows + 1 Then Columns(cNbr).EntireColumn.Hidden = True
Next cNbr
End Sub


Public Function isNothing(ByVal theString As String) As Boolean
'************************************************************************************************
'* Check if there is anything in a string (to avoid testing for isnull, isempty, and
'* zero-length strings)
'* isNothing(" This is my string ") returns False
'************************************************************************************************

isNothing = theString & "" = ""

End Function

 

[RB26DETT]

Would anyone know to write such VBA code that would do what I am after?