Sharid
Well-known Member
- Joined
- Apr 22, 2007
- Messages
- 1,064
- Office Version
- 2016
- Platform
- Windows
My Full code which is below, works on creating a copy of a worksheet, sorting out the header and freeze frame, as well as naming and date/time stamping the new sheet. All this works fine. The only issues I have is that it should also fill all BLANK sells with a Hyphen. Currently is is only doing the first 10 rows and I can not work out why.
I am adding a hyphen so the cells have some data in them, if left blank the adjacent cells data spills into the next column, making it hard to read the sheet data.
This is the issue code
Full code
I am adding a hyphen so the cells have some data in them, if left blank the adjacent cells data spills into the next column, making it hard to read the sheet data.
This is the issue code
VBA Code:
'Fill all BLANK CELLS with Hyphen
Dim r As Range, LastRow As Long
LastRow = Cells(Rows.Count, a).End(xlUp).Row
For Each r In Range("A1:g1" & LastRow)
If r.Text = "" Then r.Value = "-"
Next r
Full code
VBA Code:
Private Sub ExcelExportBt_Click()
'##### Export to excel #########
If Sheet8.Range("a2").Value = "" Then
ExportError.Show
Else
Application.SheetsInNewWorkbook = 1
Workbooks.Add
With ThisWorkbook
.Sheets("Sheet8").UsedRange.Copy 'Copy this sheet
ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
ActiveWorkbook.Sheets(1).Name = "Data Search" ' new sheet name
On Error Resume Next
'column width and header
Worksheets("Data Search").Columns("A:j").ColumnWidth = 25
'Formatting the header
Range("A1:g1").Font.Name = "Calibri"
Range("A1:g1").HorizontalAlignment = xlCenter
Range("A1:g1").Font.Color = vbWhite
Range("A1:g1").Interior.ColorIndex = 16 'Color Grey
'########################## THIS BIT IS NOT FULLY WORKING #############################
'Fill all BLANK CELLS with Hyphen
Dim r As Range, LastRow As Long
LastRow = Cells(Rows.Count, a).End(xlUp).Row
For Each r In Range("A1:g1" & LastRow)
If r.Text = "" Then r.Value = "-"
Next r
'########################## THIS BIT IS NOT FULLY WORKING #############################
'Name of Sheet and date + time stamp
ActiveWorkbook.SaveAs "Data Search" & Format(Now, " dd_mm_yyyy HH_mm_ss") & ".xlsx"
On Error Resume Next
' Create a Freeze panel on new sheet
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
With Application.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
Application.ActiveWindow.FreezePanes = True
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter
End If
Next ws
End With
End If
End Sub