I am trying to set page breaks after row number 40 but its appearing on row number: 45. The output excel file should be of two pages.
Can someone tell me the mistake which i created. Your Help will be greatly appreciated. (I tried to solve this from last 6 hours but no luck :) )
This code is part of my assignment, so i am trying this without changing the column width.
Option Explicit
Dim objExcel,objWorkbook,objSheet,objRange,intPageBreakRow,intRow,i
const xlPageBreakPreview = &H2
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
Set objSheet = objWorkbook.Worksheets(1)
Set objRange = objExcel.Range("B:F")
objRange.WrapText = TRUE
objSheet.Range("A:A").ColumnWidth = 1
objSheet.Range("B:B").ColumnWidth = 25
objSheet.Range("C:C").ColumnWidth = 25
objSheet.Range("D:D").ColumnWidth = 45
objSheet.Range("E:E").ColumnWidth = 14
objSheet.Range("F:F").ColumnWidth = 20
objSheet.DisplayAutomaticPageBreaks = False
With objSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
objSheet.PageSetup.PrintArea = ""
objSheet.ResetAllPageBreaks
intPageBreakRow=40
intRow=90
objExcel.Cells(1, 1).Value = "Page1 This is the text that we want to wrap in column A."
objExcel.Cells(2, 2).Value = "Page1 This is the text that we want to wrap in column B."
objExcel.Cells(3, 3).Value = "Page1 This is the text that we want to wrap in column C."
objExcel.Cells(5, 5).Value = "Page1 This is the text that we want to wrap in column E."
objExcel.Cells(6, 6).Value = "Page1 This is the text that we want to wrap in column F."
For i=2 To intPageBreakRow
objExcel.Cells(i, 4).Value = "Page1 This is the text that we want to wrap in column D."
Next
objSheet.Range("F72").Value = "Page2 Some text aligned to the center"
objSheet.Range("F72").WrapText = True
For i=intPageBreakRow+1 To intRow
objExcel.Cells(i, 4).Value = "Page2 This is the text that we want to wrap in column D."
Next
'objExcel.Range("A1: F"&intRow).Select
objExcel.ActiveSheet.PageSetup.PrintArea="A1: F"&intRow
objSheet.ResetAllPageBreaks
'objExcel.Rows(intPageBreakRow+1).Select
objSheet.HPageBreaks.Add objSheet.Rows(intPageBreakRow+1)
objExcel.ActiveWindow.View = xlPageBreakPreview
objExcel.Rows.AutoFit
Related
I was trying to make some cell spaces in Excel for every time Saved Invoices that go into record sheet.
But instead the last cell of item and Qty get overwritten by new save
And it didn't go as a whole one(1) order if I try to sort it from individual table.
Also, I didn't know how or what's the problem or solution that I can type to search the Google
Was trying to make something like this
example
Sub Save()
Dim SimpanInvoice As Object
Set SimpanInvoice = Sheet3.Range("A20000").End(xlUp)
If Sheet4.Range("Invonomer").Value = "" _
Or Sheet4.Range("Invotgl").Value = "" _
Or Sheet4.Range("Invoto").Value = "" _
Or Sheet4.Range("Invoalamat").Value = "" Then
Call MsgBox("Harap isi data dengan lengkap", vbInformation, "Isi Data")
Else
SimpanInvoice.Offset(1, 0).Value = Sheet4.Range("Invonomer").Value
SimpanInvoice.Offset(1, 1).Value = Sheet4.Range("Invotgl").Value
SimpanInvoice.Offset(1, 2).Value = Sheet4.Range("Invoto").Value
SimpanInvoice.Offset(1, 3).Value = Sheet4.Range("Invoalamat").Value
SimpanInvoice.Offset(1, 4).Value = Sheet4.Range("Keterangan").Value
SimpanInvoice.Offset(1, 5).Value = Sheet4.Range("item1").Value
SimpanInvoice.Offset(1, 6).Value = Sheet4.Range("Qty_1").Value
SimpanInvoice.Offset(2, 5).Value = Sheet4.Range("item2").Value
SimpanInvoice.Offset(2, 6).Value = Sheet4.Range("Qty_2").Value
Call MsgBox("Data SuratTagihan Telah Di Simpan", vbInformation, "Data Surat Tagihan")
Sheet4.Range("Invonomer").Value = ""
Sheet4.Range("Invotgl").Value = ""
Sheet4.Range("Invoto").Value = ""
Sheet4.Range("Invoalamat").Value = ""
Sheet4.Range("Keterangan").Value = ""
Sheet4.Range("item1").Value = ""
Sheet4.Range("Qty_1").Value = ""
Sheet4.Range("item2").Value = ""
Sheet4.Range("Qty_2").Value = ""
End If
End Sub
here is full code that I've been trying
Your ColA is not fully populated, so you could add a loop to make sure the row you're working on is empty
Dim SimpanInvoice As Object
Set SimpanInvoice = Sheet3.Range("A20000").End(xlUp).Offset(1)
'make sure the row we're on is completely empty (not just empty in ColA)
Do While Application.CountA(SimpanInvoice.EntireRow) > 0
Set SimpanInvoice = SimpanInvoice.Offset(1) 'next row down
Loop
'start populating the row
SimpanInvoice.Value = Sheet4.Range("Invonomer").Value
SimpanInvoice.Offset(0, 1).Value = Sheet4.Range("Invotgl").Value
'etc etc
I have slow performing procedure, it's job is to format sheets in workbook. Mainly to adjust row heights and column widths, apply number formats for columns, plane freezes and to remove autofilters. It is long, and I have deleted several similar parts to shorten it for stackoverflow, but there are no big loops, excel workbook has only several sheets and I have tried to identify slow performing part with timer, but without luck. Any ideas? Is any of these operations extra slow? It takes around 1 minute and 20 seconds to format sheets. It is quite similar to other procedures that are working with data in cells, seems to long, for cosmetic adjustments.
'Procedure to format sheets
Private Sub FormatSheets()
Dim ShHead(1 To 22) As Variant
Dim ShHead2(1 To 19) As Variant
Dim i As Long
Dim Sh As Worksheet
'Creates array of column Headers for sheets "Data", "Process", "Delete"
ShHead(1) = "BizReg_UUK": ShHead(2) = "VDVV_UUK1": ShHead(3) = "VDVV_UUK"
ShHead(4) = "VDVV_NMK": ShHead(5) = "BizReg_Nos": ShHead(6) = "VDVV_Nos"
ShHead(7) = "BizReg_NACE1_2_red": ShHead(8) = "VDVV_NACE_2_red": ShHead(9) = "Nace maiņa"
ShHead(10) = "Nace maiņas avots": ShHead(11) = "BizReg_LKV": ShHead(12) = "VDVV_LKV"
ShHead(13) = "AVG Apgr.": ShHead(14) = "AVG Darb.": ShHead(15) = "VDVV_Adr"
ShHead(16) = "Struktūras": ShHead(17) = "Sākums": ShHead(18) = "Beigas"
ShHead(19) = "Nodarbošanās": ShHead(20) = "NACE": ShHead(21) = "Change it!"
ShHead(22) = "Reason"
'Creates header for sheets "NoResult", "Result"
For i = 1 To 19
If i = 1 Then
ShHead2(i) = ShHead(i)
Else
ShHead2(i) = ShHead(i + 3)
End If
Next
'Loops all sheets in workbook and removes filters, if they exist before data are processed
For Each Sh In ThisWorkbook.Worksheets
If Sh.AutoFilterMode = True Then
Sh.AutoFilterMode = False
End If
Next Sh
'Formating sheet "Result"
With ThisWorkbook.Sheets("Result")
'Clears whole sheet
.UsedRange.Clear
'Text in first row set to bold
.Range("A4:S4").Font.Bold = True
'Creates filter
.Range("A4:S4").AutoFilter
'Writes headers
.Range("A4:S4").Value2 = ShHead2
'Sets width of columns for differnet columns
.Columns("A").ColumnWidth = 10
.Columns("B").ColumnWidth = 25
.Columns("C").ColumnWidth = 30
.Columns("D:E").ColumnWidth = 4
.Columns("F").ColumnWidth = 10
.Columns("G:I").ColumnWidth = 2
.Columns("J").ColumnWidth = 8
.Columns("K").ColumnWidth = 5.5
.Columns("L").ColumnWidth = 35
.Columns("M").ColumnWidth = 3
.Columns("N:O").ColumnWidth = 6
.Columns("P").ColumnWidth = 20
.Columns("Q").ColumnWidth = 20
.Columns("R").ColumnWidth = 5
.Columns("S").ColumnWidth = 40
'Wraps text in column
.Columns("L").WrapText = True
.Columns("S").WrapText = True
'Sets formats for columns containing numbers
.Columns("A").NumberFormat = "#"
.Columns("D:E").NumberFormat = "#"
.Columns("F").NumberFormat = "m/d/yyyy"
.Columns("J").NumberFormat = "### ### ###"
.Range("G:G").HorizontalAlignment = xlCenter
.Range("Q:Q").HorizontalAlignment = xlLeft
'Sets height for all rows
.Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("Result").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /Result/ formated!"
'Formating sheet "NoResult"
With ThisWorkbook.Sheets("NoResult")
'Clears whole sheet
.UsedRange.Clear
'Text in first row set to bold
.Range("A4:S4").Font.Bold = True
'Creates filter
.Range("A4:S4").AutoFilter
'Writes headers
.Range("A4:S4").Value = ShHead2
'Sets width of columns for differnet columns
.Columns("A").ColumnWidth = 10
.Columns("B").ColumnWidth = 25
.Columns("C").ColumnWidth = 30
.Columns("D:E").ColumnWidth = 4
.Columns("F").ColumnWidth = 10
.Columns("G:I").ColumnWidth = 2
.Columns("J").ColumnWidth = 8
.Columns("K").ColumnWidth = 5.5
.Columns("L").ColumnWidth = 35
.Columns("M").ColumnWidth = 3
.Columns("N:O").ColumnWidth = 6
.Columns("P").ColumnWidth = 20
.Columns("Q").ColumnWidth = 20
.Columns("R").ColumnWidth = 5
.Columns("S").ColumnWidth = 40
'Wraps text in column
.Columns("L").WrapText = True
.Columns("S").WrapText = True
'Sets formats for columns containing numbers
.Columns("A").NumberFormat = "#"
.Columns("D:E").NumberFormat = "#"
.Columns("F").NumberFormat = "m/d/yyyy"
.Columns("J").NumberFormat = "### ### ###"
.Range("G:G").HorizontalAlignment = xlCenter
.Range("Q:Q").HorizontalAlignment = xlLeft
'Sets height for all rows
.Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("NoResult").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /NoResult/ formated!"
'====================
'Procedure that adds finishing touches at end of procedure
Call EndProcedure
'====================
End Sub
I created an array to dynamically search content in column I in worksheet "gun inventory" and put corresponding information in column B into the array. Then I display these data in the array on the list created.
As you can see from my code, my condition is text in column I is "In Tool". However the last element in array does not have "In Tool" in element though still be included into the array. I have no idea why this happen and I will be appreciated if you can help.
I donno why S0007 will show here too.
Please ignore the variables undefined I defined them as public variables. The program runs well I just don't know why the last element will be included in the array.
Private Sub CheckGun_Click()
Dim gunarr()
Dim col As Integer
'Sheets.Add after:=Worksheets(5)
'ActiveSheet.Name = "tmp"
m = 0
With ThisWorkbook.Worksheets("gun inventory")
g = Application.WorksheetFunction.CountIf(.Range("I:I"), "In Tool")
Debug.Print g
ReDim gunarr(1 To g)
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).row
If .Cells(i, "I").Text = "In Tool" Then
m = m + 1
End If
gunarr(m) = .Cells(i, "B")
Next i
End With
row = UBound(gunarr) - LBound(gunarr)
'Worksheets("tmp").Range("A2").Resize(row + 1).Value = Application.Transpose(gunarr)
With ListBox1
.Font.Size = 10
.ForeColor = vbBlue
.ControlTipText = "Tools are in use"
.ColumnHeads = True
.ColumnCount = Range("a1").CurrentRegion.Columns.Count
.ColumnWidths = "80"
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectMulti
.List = gunarr()
End With
'On Error Resume Next
'Application.DisplayAlerts = False 'prevent alert popping up for deleting the sheet
'ThisWorkbook.Sheets("tmp").Delete
'Application.DisplayAlerts = True
End Sub
As you can see from my code, my condition is text in column I is "In Tool". However the last element in array does not have "In Tool" in element though still be included into the array. I have no idea why this happen and I will be appreciated if you can help.
I am new to VBA and I am looking for something that is similar to python pandas, i.e. avoiding to loop through each rows many times. I am trying to achieve a quite simple task and it takes way too long. What is the best alternative to loops?
Looking around it seems that AutoFilter and Find might do, however I am not sure on what is the best option in my case.
Sub UpdateManualUpdates()
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Long, t As Long
Set lookUpSheet = Worksheets("Manual price changes")
Set updateSheet = Worksheets("Price Build-up")
lastRowLookup = lookUpSheet.Cells(Rows.Count, "F").End(xlUp).Row
lastRowUpdate = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row
'get the number of the last row with data in sheet1 and in sheet2
For i = 6 To lastRowLookup 'i = 2 to last to omit the first row as that row is for headers
valueType = lookUpSheet.Cells(i, 5) 'Type of update - Both, Planning group or GC
valueGroup = lookUpSheet.Cells(i, 3) 'Family group
valueGC = lookUpSheet.Cells(i, 4) 'GC
ValueChange = lookUpSheet.Cells(i, 6) 'What is the % change
'above get the values from the four column into variables
With Worksheets("Price build-up")
For t = 6 To lastRowUpdate
'AW is column 49 target column to update
'M is target column for group, 13
'C is target column for GC, 3
If valueType = "Both" Then
If .Cells(t, 13) = valueGroup And .Cells(t, 3) = valueGC Then
.Cells(t, 49) = ValueChange
End If
End If
If valueType = "Planning group" Then
If .Cells(t, 13) = valueGroup Then
.Cells(t, 49) = ValueChange
End If
End If
If valueType = "GC" Then
If .Cells(t, 3) = valueGC Then
.Cells(t, 49) = ValueChange
End If
End If
Next t
End With
Next i
End Sub
It is slow to access and update the Workbook object. Based on what you have now, a simple way is to convert the worksheet to an array and read the data from the array. Also, set Application.ScreenUpdating = False would make it a little bit faster.
Sub UpdateManualUpdates()
Application.ScreenUpdating = False
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Long, t As Long
Set lookUpSheet = Worksheets("Manual price changes")
Set updateSheet = Worksheets("Price Build-up")
Dim lookUpSheetArray As Variant
Dim updateSheetArray As Variant
lastRowLookup = lookUpSheet.Cells(Rows.Count, "F").End(xlUp).Row
lastRowUpdate = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row
lookUpSheetArray = lookUpSheet.Range("A1:F" & lastRowLookup).Value
updateSheetArray = updateSheet.Range("A1:AW" & lastRowUpdate).Value
For i = 6 To lastRowLookup 'i = 2 to last to omit the first row as that row is for headers
valueType = lookUpSheetArray(i, 5) 'lookUpSheet.Cells(i, 5) 'Type of update - Both, Planning group or GC
valueGroup = lookUpSheetArray(i, 3) 'Family group
valueGC = lookUpSheetArray(i, 4) 'GC
ValueChange = lookUpSheetArray(i, 6) 'What is the % change
'above get the values from the four column into variables
For t = 6 To lastRowUpdate
'AW is column 49 target column to update
'M is target column for group, 13
'C is target column for GC, 3
If valueType = "Both" Then
If updateSheetArray(t, 13) = valueGroup And updateSheetArray(t, 3) = valueGC Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
If valueType = "Planning group" Then
If updateSheetArray(t, 13) = valueGroup Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
If valueType = "GC" Then
If updateSheetArray(t, 3) = valueGC Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
Next t
Next i
Application.ScreenUpdating = True
End Sub
From my experiment, it is about 35% faster. Not a big improvement but just take a minute to update.
I have 8 comboboxes on a form that I wish to populate with saved values when the user opts to do so.
The problem I have is that although the code all works only the first combobox actually updates - unless I call the sub twice (i.e the user simply clicks the command button again) and then all comboboxes populate perfectly.
It's not complex code (at all) but clearly there is something I'm missing - I'm not sure why the comboboxes all update the second time the sub is run but not the first. Any ideas?
Dim loadlimit
Dim loadrow
Dim loadprev As Boolean
Dim l(8) As String
Dim i
i = 1
loadrow = 1
loadprev = False
loadlimit = lastrow(Sheet19)
Do Until loadrow > loadlimit
If Cells(loadrow, 1).Value = geogselect.selectedind.Value Then
loadprev = True
l(1) = Cells(loadrow, 2).Value
l(2) = Cells(loadrow, 3).Value
l(3) = Cells(loadrow, 4).Value
l(4) = Cells(loadrow, 5).Value
l(5) = Cells(loadrow, 6).Value
l(6) = Cells(loadrow, 7).Value
l(7) = Cells(loadrow, 8).Value
l(8) = Cells(loadrow, 9).Value
geogselect.ComboBox1.Text = l(1)
geogselect.ComboBox2.Text = l(2)
geogselect.ComboBox3.Text = l(3)
geogselect.ComboBox4.Text = l(4)
geogselect.ComboBox5.Text = l(5)
geogselect.ComboBox6.Text = l(6)
geogselect.ComboBox7.Text = l(7)
geogselect.ComboBox8.Text = l(8)
End If
loadrow = loadrow + 1
Loop
Thanks in hope!
Thanks for all the assistance, telling Excel to setFocus before updating each combobox resolved this.