Need help on a Macro for deleting columns in Excel output

[sbehera]

Hi,

I am working on a MS access database macro which gives a output exported to an Excel.That is working fine.But there are too many columns in the exported output, out of which many columns are with all zero values.What I need is the delete the columns in the output excel where the sum of column is zero.I have tried something but was not able to do.Any help will be greatly appreciated.



thanks.

[June7]

If you don't want the columns, why include them in the export?

[sbehera]

Hi June7 , Thanks for looking into my problem.Well the output Excel report is an Query result. There may be some values in some column as a result of one criteria where as the column may be zero on other criteria.hence, I cant ignore the columns itself before knowing that the entire column will be zero. So what I need is MS Access to look into it and delete the Zero values column. Hope it makes sense.
Again thanks.

[June7]

What have you tried? Every approach I can think of is complicated.

Why is export to Excel necessary? Why is including the zero columns an issue?

[sbehera]

Actually the output is generated querying a large table where the results needed to to be compared column by column.it will be giving around 50 to 60 columns where as the zero columns are needed to be deleted to make the comparison easy. As i have not much idea in Access VBA, I was trying to do some excel VBA run from MS Access. Well if it is so complicated then I will be doing it with an Excel Macro and that I can do. As this will add another step, I was looking for doing it from Access it self.
Thanks again

[June7]

What is the comparison that needs to be done? Access has a FindUnmatched query wizard. Otherwise, VBA in Access could possibly do the comparison.

[sbehera]

well I am not sure FindUnmatched will help me..I just want to delete the zero value columns in the excel output from VBA access.If that's complicated, I will take the report what now I am getting and use an Excel Macro to delete the columns.That's fine because what the current process is taking 3 to 4 hour, may be it will take 15 minutes, what could have been reduced to 5-7 minutes.

nevertheless, thanks again.

[trevor40]

A snipit of code for you to check over, gives you an idea about how to control excel from access.
P.S. A vba macro created using the record new macro in excel can be converted to use it in access, just adjust the referencing.

Private Sub Command52_Click()
Dim strPath As String
Dim rst As DAO.Recordset
Dim Excel_Application As Excel.Application
Dim Excel_Workbook As Excel.Workbook
Dim Current_Worksheet As Excel.Worksheet
Dim Data_Range
Dim Worksheet_Name
Dim db As Database
Dim rs As Recordset
Dim headercell, firstcellref, nextname, FirstName, linecount, nextcellref, bb, CC, dd, rangestart, rangeend, Mt
Dim aa As Integer
gg = "C:\All Records for - " & Format(Date, "dd-mm-yy") & ".xls"
t = Len(Dir(gg))
If t = 0 Then
GoTo keepgoing1
Else
t = MsgBox("File already exists, Delete file and continue ?.", vbYesNo, "")
If t = vbYes Then
Kill gg
Else
Exit Sub
End If
End If
keepgoing1:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "all records query", gg, True
Set Excel_Workbook = GetObject(gg)
Set Excel_Application = Excel_Workbook.Parent
Excel_Application.WindowState = xlMinimized
Excel_Application.Visible = True
Excel_Workbook.Windows(1).Visible = True
Excel_Workbook.Worksheets(1).Name = "All Records"
Excel_Workbook.Worksheets("All Records").Tab.ColorIndex = 37
Set Current_Worksheet = Excel_Workbook.Worksheets("All Records")
Excel_Workbook.Worksheets("All Records").Select
Current_Worksheet.Cells.Select
With Selection
Current_Worksheet.Cells.HorizontalAlignment = xlRight
Current_Worksheet.Cells.Font.Name = "Times New Roman"
End With
Current_Worksheet.PageSetup.Orientation = xlLandscape
Current_Worksheet.Range("A1:L1").HorizontalAlignme nt = xlCenter
Current_Worksheet.Range("A1:L1").VerticalAlignment = xlCenter
Current_Worksheet.Range("A1:L1").Font.Bold = True
Current_Worksheet.Range("A1:L1").Font.Size = 14
Current_Worksheet.Range("A1:L1").Interior.ColorInd ex = 14
Current_Worksheet.Range("A1:L1").Font.ColorIndex = 2
Current_Worksheet.Cells.SpecialCells(xlCellTypeLas tCell).Select
Last_Cell = Current_Worksheet.Cells.SpecialCells(xlCellTypeLas tCell).Address
rng1 = "A$1:L" & Mid(Last_Cell, 4, 3) ' Mid(Current_Worksheet.Cells.SpecialCells(xlCellTyp eLastCell).Address, 4, 3) - 1"
Current_Worksheet.Range(rng1).Select
With Selection
Current_Worksheet.ListObjects.Add(xlSrcRange, , xlYes, xlYes).Name = "List1"
End With
Current_Worksheet.Range("C2").Select
Excel_Application.ActiveWindow.FreezePanes = True
Current_Worksheet.Range("A1:L1").Borders(xlEdgeTop ).LineStyle = xlContinuous
Current_Worksheet.Range("A1:L1").Borders(xlEdgeTop ).Weight = xlThin
Current_Worksheet.Range("A1:L1").Borders(xlEdgeTop ).ColorIndex = xlAutomatic
Current_Worksheet.Range("A1:L1").Borders(xlEdgeBot tom).LineStyle = xlContinuous
Current_Worksheet.Range("A1:L1").Borders(xlEdgeBot tom).Weight = xlThin
Current_Worksheet.Range("A1:L1").Borders(xlEdgeBot tom).ColorIndex = xlAutomatic
Current_Worksheet.Range("A1:L1").Borders(xlEdgeLef t).LineStyle = xlContinuous
Current_Worksheet.Range("A1:L1").Borders(xlEdgeLef t).Weight = xlThin
Current_Worksheet.Range("A1:L1").Borders(xlEdgeLef t).ColorIndex = xlAutomatic
Current_Worksheet.Range("A1:L1").Borders(xlEdgeRig ht).LineStyle = xlContinuous
Current_Worksheet.Range("A1:L1").Borders(xlEdgeRig ht).Weight = xlThin
Current_Worksheet.Range("A1:L1").Borders(xlEdgeRig ht).ColorIndex = xlAutomatic
Current_Worksheet.Range("A1:L1").Borders(xlInsideV ertical).LineStyle = xlContinuous
Current_Worksheet.Range("A1:L1").Borders(xlInsideV ertical).Weight = xlThin
Current_Worksheet.Range("A1:L1").Borders(xlInsideV ertical).ColorIndex = xlAutomatic
Current_Worksheet.Range("1:1").RowHeight = 37.5
Current_Worksheet.Range("A1:L1").WrapText = True
Current_Worksheet.Range("D1").Value = "Normal Start Time"
Current_Worksheet.Range("E1").Value = "Normal End Time"
Current_Worksheet.Range("H1").Value = "Scan Time In"
Current_Worksheet.Range("K1").Value = "Scan Time Out"
Current_Worksheet.Range("A:A").ColumnWidth = 16
Current_Worksheet.Range("B:B").ColumnWidth = 16
Current_Worksheet.Range("C:C").ColumnWidth = 10.43
Current_Worksheet.Range("D:d").ColumnWidth = 16.14
Current_Worksheet.Range("E:E").ColumnWidth = 16.14
Current_Worksheet.Range("F:F").ColumnWidth = 15.29
Current_Worksheet.Range("G:G").ColumnWidth = 13.57
Current_Worksheet.Range("H:H").ColumnWidth = 14
Current_Worksheet.Range("I:I").ColumnWidth = 25
Current_Worksheet.Range("J:J").ColumnWidth = 12.71
Current_Worksheet.Range("K:K").ColumnWidth = 16
Current_Worksheet.Range("L:L").ColumnWidth = 25
rng1 = "A$2:L" & Mid(Last_Cell, 4, 3) ' Mid(Current_Worksheet.Cells.SpecialCells(xlCellTyp eLastCell).Address, 4, 3) - 1"
Current_Worksheet.Range(rng1).Select
Current_Worksheet.Range(rng1).Interior.ColorIndex = 34
Current_Worksheet.Range("C2").Select
Excel_Workbook.Save
MsgBox "Output to Excel complete," & vbCrLf & "File saved to - C:\All Records.xls" & vbCrLf & "Use Alt + TAB to switch to Excel and view results", vbOKOnly, "Report"
End Sub