I am building a tool on excel, I need to check if text fits the cell, if not I have to merge cells to fit text. cells are fixed I cannot use autofit or option.
Please suggest VB Code, thanks in advance
Answered elsewhere, but this is a basic code that works. Autosize.
Sub merger()
Set c = ActiveSheet.Range("A:A").Find(what:="Executive Weekly Summary")
If Not c Is Nothing Then
startrow = c.Row + 1
endrow = ActiveSheet.Range("A" & startrow).End(xlDown).Row - 1
End If
'"A" & startrow & ":I" & endrow
OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth ' Save original width
ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
fitwidth = ActiveSheet.Range("A:A").ColumnWidth ' Get width required to fit entire text
ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth ' Restore original width
If OldWidth < fitwidth Then
Do Until OldWidth = fitwidth
ActiveSheet.Range("").Merge
endrow = endrow + 1
OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth
ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
fitwidth = ActiveSheet.Range("A:A").ColumnWidth
ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth
Loop
End If
End Sub
Related
I have a table which has around 50 columns. Below function works fine. But how can I put a loop across the columns? I cannot write formulas for each column. I cannot use WorksheetFunction.Sum. I require Sum formula to be added in the cell.
Sub Sum_Last_Row()
With Worksheets("Revenue_forecast_table")
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("E" & LastRow + 1).Formula = "=SUM(E5:E" & LastRow & ")"
.Range("F" & LastRow + 1).Formula = "=SUM(F5:F" & LastRow & ")"
.Range("G" & LastRow + 1).Formula = "=SUM(G5:G" & LastRow & ")"
.Range("H" & LastRow + 1).Formula = "=SUM(H5:H" & LastRow & ")"
.Range("I" & LastRow + 1).Formula = "=SUM(I5:I" & LastRow & ")"
.Range("J" & LastRow + 1).Formula = "=SUM(J5:J" & LastRow & ")"
End With
End Sub
You can populate the whole row at once and the formula will auto-adjust:
Sub Sum_Last_Row()
Dim NextRow As Long
With Worksheets("Revenue_forecast_table")
NextRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("E" & NextRow & ":J" & NextRow).Formula = _
"=SUM(E5:E" & NextRow - 1 & ")"
End With
End Sub
It looks like a simple enough code to me, but I can't get it to work properly. I'm trying to iterate through rows of values in order to add them one at a time to a display row, storing the previous value in an extra row in order to avoid circular calculations.
The WriteRow loads properly on the first iteration, but after that all results in the WriteRow and StoreRow are 0.
Here's the code:
Const StartRow As Long = 2
Const LastRow As Long = 367
Const StoreRow As Long = 369
Const WriteRow As Long = 370
Dim RowNumber As Long
Range("A" & StoreRow, "T" & StoreRow).ClearContents
Range("A" & WriteRow, "T" & WriteRow).ClearContents
DoEvents
Application.Wait (Now + TimeValue("00:00:1"))
For RowNumber = StartRow To LastRow
DoEvents
Range("A" & WriteRow, "T" & WriteRow).FormulaArray = "=A" & StoreRow & ":T" & StoreRow & "+A" & RowNumber & ":T" & RowNumber
Range("A" & StoreRow, "T" & StoreRow).FormulaArray = "=A" & WriteRow & ":T" & WriteRow
Application.Wait (Now + TimeValue("00:00:1"))
DoEvents
Next RowNumber
End Sub
I did also try adding Range("A" & WriteRow, "T" & WriteRow).AutoFill Destination:=Range("A" & WriteRow & ":T" & WriteRow), but the AutoFill kept failing. The formula bar shows "{=A370:T370}" for StoreRow and "{=A369:T369+A2:T2}" for WriteRow.
I think the problem is that there's still a circular reference. Is there a good way to get around it?
Found an answer that produces the results I was looking for:
Sub ExpensesChart()
Const StartRow As Long = 2
Const LastRow As Long = 367
Const StoreRow As Long = 369
Const WriteRow As Long = 370
Dim RowNumber As Long
Dim val As Double
Range("A" & StoreRow, "T" & StoreRow).ClearContents
Range("A" & WriteRow, "T" & WriteRow).ClearContents
For RowNumber = StartRow To LastRow
DoEvents
Range("A" & WriteRow, "T" & WriteRow).FormulaArray = "=A" & StoreRow & ":T" & StoreRow & "+A" & RowNumber & ":T" & RowNumber
Range("A" & WriteRow, "T" & WriteRow).Formula = Range("A" & WriteRow, "T" & WriteRow).Value
Range("A" & StoreRow & ":T" & StoreRow).FormulaArray = Array(Range("A" & WriteRow & ":T" & WriteRow))
Application.Wait (Now + TimeValue("00:00:1"))
DoEvents
Next RowNumber
End Sub
I have a table. I put some data into the row beneath the table with vba(see sub formulas).
Then resize the table to include the newly added data(see ResizeListDyn)
The newly added data is now included in the old table.
But my pivot does not reflect the full new table when i refresh.
I have a pivot with the data source that is targeting this table.
Sub Formulas()
LastRow = WorksheetFunction.Max(Sheets("working").Cells(Rows.Count, "x").End(xlUp).Row)
With Worksheets("working")
.Range("x" & LastRow + 1).Formula = "=X" & LastRow & "+7"
.Range("y" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",irworstcase!A:F,6,FALSE)"
.Range("z" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",irworstcase!A:E,5,FALSE)"
.Range("aa" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",A$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AA$1,""ScenarioName"",$Y53)"
.Range("ab" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",B$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AB$1,""ScenarioName"",$Y53)"
.Range("ac" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",C$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AC$1,""ScenarioName"",$Y53)"
.Range("ad" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",D$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AD$1,""ScenarioName"",$Y53)"
.Range("ae" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",E$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AE$1,""ScenarioName"",$Y53)"
.Range("af" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",F$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AF$1,""ScenarioName"",$Y53)"
.Range("ag" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",G$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AG$1,""ScenarioName"",$Y53)"
.Range("ah" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",'pv01'!A:C,3,FALSE)"
Call ResizeListDyn
End With
End Sub
Sub ResizeListDyn()
Worksheets("working").Activate
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
tbl.Resize tbl.Range.CurrentRegion
End Sub
Then when I refresh my pivot, it does not include the full new table.
Any ideas as to why?
There is a particular part of my code which I cannot make work,
I'm trying to do the following command on VBA =RIGHT(LEFT(X1;Z1-2);LEN(LEFT(X1;Z1-2))-FIND(":";X1))
On cell X1, there is a text: RESULTS:NG & MODEL:IJ
My VBA code is:
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LR
cel = "A" & i
cel2 = "Y" & i
cel3 = "Z" & i
cel4 = "X" & i
Range("M" & i).Formula = "=RIGHT(LEFT(" & cel4 & "," & cel3 & "-" & 2 & "),LEN(LEFT(" & cel4 & "," & cel3 & "-" & 2 & "))-FIND(:" & cel4 & "))"
Next i
I'm open for a better approach for this issue as well
Thanks in advance
Try writing all the formulas at once and reduce using quotes within the formula as much as possible.
Range(Cells(1, "M"), cells(lr, "M")).Formula = _
"=RIGHT(LEFT(X1, Z1-2), LEN(LEFT(X1, Z1-2))-FIND(char(58), X1))"
All range and cells reference within a sub procedure are better with a properly defined parent worksheet reference.
dim lr as long
with worksheets("sheet1")
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(1, "M"), .cells(lr, "M")).Formula = _
"=RIGHT(LEFT(X1, Z1-2), LEN(LEFT(X1, Z1-2))-FIND(char(58), X1))"
end with
I have written a very straightforward script which writes data into excel cells.
Basically, this is a loop over an array and it writes data into specific cells or formulas.
The problem is that this part of the script is extremly slow.
Any ideas on how to improve thath?
Thanks.
For j = 0 To i - 1
'Insère nouvelle ligne
Rows(startRow & ":" & startRow).Select
Selection.Copy
Rows(startRow + 1 & ":" & startRow + 1).Select
Selection.Insert Shift:=xlDown
'Insère données
If roomType(j) <> "" Then
Feuil3.Cells(startRow, 1).Value = roomName(j)
Feuil3.Cells(startRow, 2).Value = roomSurface(j)
Feuil3.Cells(startRow, 7).Value = roomPeople(j)
Feuil3.Cells(startRow, 12).Value = roomPeople(j)
Feuil3.Cells(startRow, 5).Value = dict.Item(roomType(j))
Feuil3.Cells(startRow, 3).Value = roomHeight(j)
Feuil3.Range("F" & startRow).Formula = "=IFERROR(IF($E" & startRow & "=Data!$A$55,,ROUNDUP($B" & startRow & "/VLOOKUP($E" & startRow & ",Data!$A$3:$E$55,4,FALSE),0)),)"
Feuil3.Range("H" & startRow).Formula = "=$C$25"
Feuil3.Range("I" & startRow).Formula = "=IF($E" & startRow & "=Data!$A$55,$B" & startRow & "*$E$55,(MAX(F" & startRow & ",G" & startRow & ")*H" & startRow & "))"
Feuil3.Range("N" & startRow).Formula = "=IFERROR(VLOOKUP($K" & startRow & ",$M$22:$O$26,3,FALSE),)"
Feuil3.Range("O" & startRow).Formula = "=IFERROR(IF(ISBLANK(M" & startRow & ")=TRUE,L" & startRow & "*N" & startRow & ",L" & startRow & "*M" & startRow & "*N" & startRow & "),)"
Feuil3.Range("Q" & startRow).Formula = "=MAX(I" & startRow & ",O" & startRow & ")"
Feuil3.Range("T" & startRow).Formula = "=IFERROR(MAX(R" & startRow & ",S" & startRow & ")/(B" & startRow & "*C" & startRow & "),)"
End If
startRow = startRow + 1
Next j
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
It is quicker to assign an array to a range of cells than to assign to individual cells in a loop. You could try sometihing like: Worksheets("MySheet").Range("A1:D100").Value = myArray. It is because communication between VBA and Excel takes some time. A little bit more on that here: VBA Excel large data manipulation taking forever
Also using Cells instead of Range is aboout 2.6 times faster. Here is a question on that: Range() VS Cells() - run times
I cut the script in pieces.
This part takes most of the time
For j = 0 To i - 2
Feuil3.Cells(startRow, 5).Value = dict.Item(roomType(j))
Feuil3.Cells(startRow, 6).Formula = "=IFERROR(IF($E" & startRow & "=Data!$A$55,,ROUNDUP($B" & startRow & "/VLOOKUP($E" & startRow & ",Data!$A$3:$E$55,4,FALSE),0)),)"
Feuil3.Cells(startRow, 8).Formula = "=$C$25"
Feuil3.Cells(startRow, 9).Formula = "=IF($E" & startRow & "=Data!$A$55,$B" & startRow & "*$E$55,(MAX(F" & startRow & ",G" & startRow & ")*H" & startRow & "))"
Feuil3.Cells(startRow, 14).Formula = "=IFERROR(VLOOKUP($K" & startRow & ",$M$22:$O$26,3,FALSE),)"
Feuil3.Cells(startRow, 15).Formula = "=IFERROR(IF(ISBLANK(M" & startRow & ")=TRUE,L" & startRow & "*N" & startRow & ",L" & startRow & "*M" & startRow & "*N" & startRow & "),)"
Feuil3.Cells(startRow, 17).Formula = "=MAX(I" & startRow & ",O" & startRow & ")"
Feuil3.Cells(startRow, 20).Formula = "=IFERROR(MAX(R" & startRow & ",S" & startRow & ")/(B" & startRow & "*C" & startRow & "),)"
startRow = startRow + 1
Next j