I wish to delete the row below the item added,because once I click confirm sales and want to add more item. the item added will directly replace the row "grand total","gst", and so on. May I know how should I do?
Screenshot
Here is my code for add cart :
Sub addcart()
Dim lastrow As Long
Dim i As Integer, j As Integer, k As Integer, m As Integer
lastrow = Sheets("Sales Point").Range("E" & Rows.Count).End(xlUp).Row
If Range("C6").Value = 0 = False And IsEmpty(Range("C6").Value) = False Then
'Number of item
For i = 5 To lastrow + 1
Cells(i, 5).Value = i - 4
Next
Cells(lastrow + 1, 6) = Range("C4") 'Item code
Cells(lastrow + 1, 7) = Range("C3") 'Item Name
Cells(lastrow + 1, 8) = Range("C6") 'Quantity
Cells(lastrow + 1, 9) = Format(Range("C5"), "$#,##.00#") 'Unit Price
Cells(lastrow + 1, 10) = Format(Cells(lastrow + 1, 9) * Cells(lastrow + 1, 8), "$#,##.00#") 'Total
Else
MsgBox "Error Message!!!"
End If
End Sub
What about this:
Range("A" & (LastRow + 1)).Offset(1,0).EntireRow.Delete
Explanation:
I believe that the last row equals LastRow + 1?
Offset(1,0) is the cell on the next row.
EntireRow.Delete is obvious.
Related
Im looking for a solution to get the result as in the screenshot. If theres at least 3 blanks or more then change second cell from first blank on first column to "x" :
Sub findThreeEmptyCells()
Dim lastRow As Long, i As Long
Dim firstEmptyCell As Range
lastRow = Cells(Rows.Count, 5).End(xlUp).Row
For i = 10 To lastRow
If Cells(i + 1, 5).Value = "" And Cells(i + 2, 5).Value = "" Then
Set firstEmptyCell = Cells(i + 2, 1)
Exit For
End If
Next i
If firstEmptyCell Is Nothing Then
MsgBox ("There are no two empty cells in a row")
Exit Sub
End If
firstEmptyCell.Value = "x"
End Sub
Sub findThreeEmptyCells()
Dim lastRow As Long, i As Long
Dim firstEmptyCell As Range
lastRow = Cells(Rows.Count, 5).End(xlUp).Row ' Assuming your column A has the most data or is the row you want to check.
For i = 10 To lastRow
If Cells(i + 1, 5).Value = "" And Cells(i + 2, 5).Value = "" And Cells(i + 3, 5).Value = "" Then
Set firstEmptyCell = Cells(i + 2, 1)
Exit For
End If
Next i
If firstEmptyCell Is Nothing Then
MsgBox ("There are no two empty cells in a row")
Exit Sub
End If
firstEmptyCell.Value = "x"
End Sub
*** Edit 7/19
#AcsErno The formula to sum works fine, but since there's 8 rows, it enters the sum in each blank row. Is there a way to enter more than 1 formula into the code?
I've tried to copy the formula (Cells(LastRow + 2, j).FormulaLocal...) and change the +1 to +2 (and so forth), but only the first blank row sums the range desired, the other ones either sum/equal to the row above it.
Updated Excel
'sum inbetween blanks
finalRow = Cells(Worksheets("page1").Rows.Count, 1).End(xlUp).Row
For Each j In Array(12, 13, 14) 'original: For j = 1 To finalCol
For i = finalRow + 1 To 1 Step -1
If IsEmpty(Cells(i, j)) Then
If IsEmpty(Cells(i - 2, j)) Then
firstrow = i - 1
LastRow = firstrow
Else
LastRow = i - 1
firstrow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(LastRow + 1, j).FormulaLocal = _
"= sum(" & Range(Cells(firstrow, j), Cells(LastRow, j)).Address(False, False) & ")"
Cells(LastRow + 2, j).FormulaLocal = _
"= sum(" & Range(Cells(firstrow, j), Cells(LastRow, j)).Address(False, False) & ")"
End If
Next i
Next j
Application.ScreenUpdating = True
If it helps, here are some of the formulas I'll be using:
=SUMIF(P138:P158,"<>*Hold*",L138:L158)
=SUM(SUMIF(H5:H21,{"China"},L5:L21))
=SUM(SUMIF(H5:H21,{"Other"},L5:L21))
=SUM(SUMIF(O12:O28,{"*H1*"},L12:L28))
=SUM(SUMIF(O12:O28,{"H2","H2-PRESSED"},L12:L28))
Link to Sum Code
Link to Enter Blank Rows
My data is separated with 8 blank rows for each different week number with 8 blank rows. I need to insert formulas that sum specific things within each week/between the blanks.
The amount of rows will be dynamic, so the formulas need to be too. The only code I used to sum only works well if it has 1 blank row in between, (not 8), and I'm not sure how to add more rows/formulas with it.
Here is what the excel looks like (shortened version)
Here is what I'm trying to make it look like
'insert blank columns based on change in wk
Dim X As Long, LastRow As Long
Const DataCol As String = "A"
Const StartRow = 2
LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row
For X = LastRow To StartRow + 1 Step -1
If Cells(X, DataCol).Value <> Cells(X - 1, DataCol) Then Rows(X).Resize(8).Insert
Next
finalRow = Cells(Worksheets("page1").Rows.Count, 1).End(xlUp).Row
finalCol = Cells(1, Worksheets("page1").Columns.Count).End(xlToLeft).Column
For j = 12 To 14 'original: For j = 1 To finalCol
For i = finalRow + 1 To 1 Step -1
If IsEmpty(Cells(i, j)) Then
If IsEmpty(Cells(i - 2, j)) Then
firstrow = i - 1
LastRow = firstrow
Else
LastRow = i - 1
firstrow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(i, j) = Application.WorksheetFunction.Sum(Range(Cells(firstrow, j), Cells(LastRow, j)))
End If
Next i
Next j
It is not clear why you are changing firstrow in every loop. Also, why are you overwriting original values in the column. If you have a static table and want to summarize a column underneath, simply identify the first and the last row (as you correctly do), and
Cells(LastRow + 1, j) = Application.WorksheetFunction.Sum(Range(Cells(firstrow, j), Cells(LastRow, j)))
or you can insert a formula
Cells(LastRow + 1, j).FormulaLocal = _
"=sum(" & Range(Cells(firstrow, j), Cells(LastRow, j)).Address(False, False) & ")"
You can also consider SUMIF to add H1 and H2 categories only.
It is also not clear why you are summarizing string columns. It makes no sense. You know exactly where the numeric columns are so you can specify the column numbers. I suggest option 1:
For j = 6 To 8
or option 2:
For Each j in Array (6,7,8) ' it is more flexible
I currently have a macro that inserts 3 rows when the value in Column E changes (Course Department). In the 3 rows I am trying to merge the middle row and add the department into this row. I can't work out how to get it to merge, any help would be appreciated.
With Range("e" & myHeader + 2, Range("e" & Rows.Count).End(xlUp)).Offset(, 1)
.Formula = _
"=if(and(r[-1]c[-1]<>"""",rc[-1]<>"""",r[-1]c[-1]<>rc[-1])," & _
"if(r[-1]c=1,""a"",1),"""")"
.Value = .Value
On Error Resume Next
For i = 1 To 3
.SpecialCells(2, 1).EntireRow.Insert
.SpecialCells(2, 2).EntireRow.Insert
Next
This is how it is currently:
This is what I would like to have:
When inserting or deleting rows, work from the bottom up. Some simple offsets and resizing should be sufficient to insert the three rows, merge the cells and transfer the values.
Option Explicit
Sub insertDept3()
Dim i As Long
With Worksheets("sheet10")
For i = .Cells(.Rows.Count, "E").End(xlUp).Row - 1 To 1 Step -1
If .Cells(i, "E").Value <> .Cells(i + 1, "E").Value Or i = 1 Then
.Cells(i + 1, "A").Resize(3, 5).Insert shift:=xlDown
.Cells(i + 2, "A").Resize(1, 5).Merge
.Cells(i + 2, "A") = .Cells(i + 4, "E").Value
End If
Next i
End With
End Sub
I will leave the cell alignment and font formatting to you.
The below code loop column E, import three lines when the value change, merger Column A to column E , import and format value in the middle line.
Try:
Option Explicit
Sub test()
Dim i As Long, Lastrow As Long
Dim Department As String, NextDepartment As String
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row
For i = Lastrow To 2 Step -1
Department = .Range("E" & i).Value
NextDepartment = .Range("E" & i).Offset(-1, 0).Value
If Department <> NextDepartment Then
.Rows(i).EntireRow.Resize(3).Insert
.Range("A" & i + 1 & ":E" & i + 1).Merge
With .Range("A" & i + 1)
.Value = Department
.Font.Bold = True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
End If
Next i
End With
Output:
I know how to insert rows for sequential missing values, but how can I do this for unique values that I store in a range? For example:
Range of all needed values New list with missing values
2 2
3 5
5 7
6 15
7
10
15
The code below adds rows in a sequence (i.e. if list is 2 3 5, it adds 4) so it's not what I need but I don't know how to make it loop through a range and take values only from it
Sub RowsInSequence()
Dim i As Long, j As Long
i = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For j = i To 1 Step -1
If Cells(j + 1, 1) <> "" Then
If Cells(j + 1, 1).Value - Cells(j, 1).Value > 1 Then
x = Cells(j + 1, 1).Value - Cells(j, 1).Value
Rows(j + 1 & ":" & x + j - 1).Insert
End If
End If
Next j
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
.Formula = "=Row()"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub
I have an excel sheet with more than 2000 rows.
I use the below macro to add a blank rows with a change in value of cloumn A1.
Sub AddBlankRows()
'
Dim iRow As Integer
Range("a1").Select
'
iRow = 1
'
Do
'![enter image description here][1]
If Cells(iRow + 1, 1) <> Cells(iRow, 1) Then
Cells(iRow + 1, 1).EntireRow.Insert shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, 1).Text = ""
'
End Sub
Is there a way insert the row (same with the above macro) with a fourmula and a predefined formatting?
Below is the sample code.
Sub AddBlankRows()
Dim lastRow As Long
Dim iRow As Long
Dim cursor As Long
cursor = 2
With ThisWorkbook.Sheets("sheet1")
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If (LCase(Trim(.Cells(i, 1))) <> LCase(Trim(.Cells(i + 1, 1)))) Then
.Cells(i + 1, 1).EntireRow.Insert shift:=xlDown
.Cells(i + 1, 1).EntireRow.Interior.Color = vbYellow
lastRow = lastRow + 1
.Cells(i + 1, 2) = WorksheetFunction.Count(.Range(.Cells(cursor, 2), .Cells(i, 2)))
.Cells(i + 1, 2).NumberFormat = "0"
.Cells(i + 1, 3) = WorksheetFunction.Sum(.Range(.Cells(cursor, 3), .Cells(i, 3)))
.Cells(i + 1, 3).NumberFormat = "0.00"
i = i + 2
cursor = i
End If
Next
.Cells(lastRow + 1, 1).EntireRow.Insert shift:=xlDown
.Cells(lastRow + 1, 1).EntireRow.Interior.Color = vbYellow
.Cells(lastRow + 1, 2) = WorksheetFunction.Count(.Range(.Cells(cursor, 2), .Cells(lastRow, 2)))
.Cells(lastRow + 1, 2).NumberFormat = "0"
.Cells(lastRow + 1, 3) = WorksheetFunction.Sum(.Range(.Cells(cursor, 3), .Cells(lastRow, 3)))
.Cells(lastRow + 1, 3).NumberFormat = "0.00"
End With
End Sub