Add the sum of the total amount from the sheet - excel

Thanks for opening my thread. I need help from you.
So in this sheet the total amount should be sum of fuel + surge + delivery_charge should be added in Total amount column.
Ex:- 1st order = 456777 this should add 109.49+303.41+25966.51 = 26379.41
2nd order = 23213213 should add 10+11318+65 = 11393
Dim i As Long, lastrow As Long, rng As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, "A") <> "" Then
rng = Cells(i, "A").End(xlDown).Row - 1
Cells(i, "B").Value = WorksheetFunction.Sum(Range("C" & i & ":C" & rng), Range("E" & i & ":E" & rng), Range("G" & i & ":G" & rng))
End If
Next i
I'm getting output from this logic :
But the issue is for 2nd order id. It should take only that row. But here its taking 5th and 6th row for addition.
2nd order id= 23213213 total_amt should be 11393.
So anyone could you please help me to find out an issue.
Thanks and Regards,
Ranger

The issue is in how you find rng.
rng = Cells(i, "A").End(xlDown).Row - 1
You're using xlDown to find the start of the next block of data. This works as you'd expect, except where the data changes every cell. If you click on cell A5 and press CTRL-Shift-Down, you'll see that it selects three cells as it jumps to the end of that block of data (A7). This is normal Excel behaviour.
You could re-write your code to loop through all the data until it finds the right scenario, but in this case I believe the single cell issue can just be trapped with the right If statement.
If Cells(i + 1, "A") <> "" Then rng = i
Try this:
Dim i As Long, lastrow As Long, rng As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, "A") <> "" Then
rng = Cells(i, "A").End(xlDown).Row - 1
If Cells(i + 1, "A") <> "" Then rng = i
Cells(i, "B").Value = WorksheetFunction.Sum(Range("C" & i & ":C" & rng), Range("E" & i & ":E" & rng), Range("G" & i & ":G" & rng))
End If
Next i

Related

Deleting Cells after Concatenation in VBA

I am trying to reformat a text file that has been imported into Excel.
I have done several minor reformatting points including adding rows, deleting page numbers, and combining headlines back into a single cell via the & function (the text file was delimited when importing).
After a concatenate, in which I took certain cells from columns A-Z and combined them in Column A, I tried to delete the now redundant information from Columns B-Z.
I tried selecting the cells and deleting, and also Range.Clear, but it does not delete the cells. I receive no errors.
This is what I have to take care of this step:
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
Ultimately, I would like to check if column A contains no information one row above the row where I would like to delete information from columns B-Z.
Full code:
Sub Format()
'This will delete page numbers
Dim lRow As Long
Dim iCntr As Long
lRow = 350
For iCntr = lRow To 1 Step -1
If IsNumeric(Cells(iCntr, 1)) Then
Rows(iCntr).Delete
End If
Next
'Add Row above each row with Headings
Dim lRow2 As Long, iRow As Long
With Worksheets("Sheet1")
lRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row in column A
'loop backwards (bottom to top = Step -1) through all rows
For iRow = lRow2 To 1 Step -1
'check if column A of current row (iRow) is "DIM"
If .Cells(iRow, "A").Value = "DIM" Then
.Rows(iRow).Resize(RowSize:=1).Insert xlShiftDown
'insert 1 row and move current (iRow) row down (xlShiftDown)
'means: insert 1 row ABOVE current row (iRow)
End If
Next iRow
End With
'Combine Headings back to single Cell
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
For i = lastRow To 1 Step -1
If Cells(i, 1).Value = "DIM" Then
Cells(i, 1).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & _
Cells(i, 3).Value & " " & Cells(i, 4).Value & " " & Cells(i, 5).Value & " " & _
Cells(i, 6).Value & " " & Cells(i, 7).Value & " " & Cells(i, 8).Value & " " & _
Cells(i, 9).Value & " " & Cells(i, 10).Value & " " & Cells(i, 11).Value & " " & _
Cells(i, 12).Value & " " & Cells(i, 13).Value & " " & Cells(i, 14).Value & " " & _
Cells(i, 15).Value & " " & Cells(i, 16).Value & " " & Cells(i, 17).Value & " " & _
Cells(i, 18).Value & " " & Cells(i, 19).Value & " " & Cells(i, 20).Value & " " & _
Cells(i, 21).Value & " " & Cells(i, 22).Value & " " & Cells(i, 23).Value & " " & _
Cells(i, 24).Value & " " & Cells(i, 25).Value & " " & Cells(i, 25).Value
End If
Next
'Fix Duplicate Cells from Concatenate
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(i, 1).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 26)).Clear
End If
Next
End Sub
The reason I have a condition set for the clearing of cells after concatenate is because I do not simply want to clear all cells in range B:Z, or even the specific rows in this range. I only want to clear this range in the instances where there is a blank line above it (headers to data). The reason being: I am trying to keep the spreadsheet as generic as possible in order to use it again if the specific layout of rows changes based on the input file.
First, the variable lastRow2 doesn't seem to be declared, and as you don't get any errors, you obviously don't use Option Explicit. Please do, because that will warn you about such errors.
Secondly, I don't see that you in any way initialize lastRow2, which explains why the loop is never run. Did you run the code in the debugger to verify values of variables and progress of the execution? That is the first thing to do when you see unexpected results.
Thirdly, I don't understand why you have the condition and why you use offset If IsEmpty(Range(i, 1).Offset(-1, 0)) = True. Just clear the cells explicitly
Try this instead:
lastColumn = 26
For i = lastRow To 1 Step -1
Range(Cells(i, 2), Cells(i, lastColumn)).Clear
Next
edit:
I noticed you have the last column as 25 (as well as the previous one) in the part where you concatenate the values from the cells. The correct last column is 26.
edit2:
Based on your edit of your question and assuming you have declared and initialized lastRow2 the corrected function would look like this:
For i = lastRow2 To 2 Step -1
If IsEmpty(Range(Cells(i, 1), Cells(i, 1)).Offset(-1, 0)) = True Then
ActiveSheet.Range(Cells(i, 2), Cells(i, 4)).Clear
End If
Next

Find Duplicated data in multiple cells and copy all to other excel sheet

I have excel sheet with around 40k records and 5 columns. I want to search duplicates in column 3, 4, 5 and copy whole row in new sheet.
#Emm Jay could you please be more specific? I m not sure what are you asking for, but the below code may help you to get an overall idea.
Let's say that Sheet 1 contains our data & duplicate rows will copy on Sheet 2.
Sheet 1:
Sheet 2 - Output:
Code:
Option Explicit
Sub Duplicates()
Dim LastrowS1 As Long, LastrowS2 As Long, i As Long, j As Long
Dim CombineStrI As String, CombineStrJ As String
LastrowS1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastrowS1
CombineStrI = Sheet1.Range("C" & i).Value & "_" & Sheet1.Range("D" & i).Value & "_" & Sheet1.Range("E" & i).Value
For j = 2 To LastrowS1
CombineStrJ = Sheet1.Range("C" & j).Value & "_" & Sheet1.Range("D" & j).Value & "_" & Sheet1.Range("E" & j).Value
If j <> i Then
If CombineStrI = CombineStrJ Then
Sheet1.Rows(i).Copy
LastrowS2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Sheet2.Range("A" & LastrowS2 + 1).PasteSpecial
End If
End If
Next j
Next i
End Sub

add missing date and missing item vba excel

I need some help to setup this vba.
I'm looking to add a cell with the date is missing and driver.
for example.
10/29/2018 Name Item driver
10/30/2018 Name Item driver
(add missing date here, no available , no available and driver)
11/02/2018 Name Item driver
if the date is missing and the driver is also missing to add it in.
I hope this helps.
The code below assumes that the values starts at A2 and that all the relevant data is stored in order eg.column B-D. This will insert a row and fill in the data so that every date has an entry. If you have a lot of data to process it might be worthwhile to add in the usual Application.calculation=xlmanual and application.screenupdating = false to speed it up. Just be sure to reset them back to their default states when you're done
Option Explicit
Sub datefiller()
Dim i As Long
Dim lastdate As Long
Dim startDate As Long
Dim TotalRows As Long
i = 2
With ThisWorkbook.Worksheets(1)
While Not IsEmpty(.Range("A" & i).Value)
If Not .Range("A" & i).Value = .Range("A" & i - 1).Value + 1 Then
.Range("A" & i).EntireRow.Insert shift:=xlDown
.Range("A" & i).Value = .Range("A" & i - 1).Value + 1
.Range("B" & i & ":C" & i).Value = "N/A"
.Range("D" & i).Value = "driver"
Else
i = i + 1
End If
Wend
End With
End Sub
EDIT: Adding in the driver's name and accounting for different groupings
Option Explicit
Sub datefiller()
Dim i As Long
Dim lastdate As Long
Dim startDate As Long
Dim TotalRows As Long
i = 3
With ThisWorkbook.Worksheets(1)
While Not IsEmpty(.Range("A" & i).Value)
If (Not .Range("A" & i).Value = .Range("A" & i - 1).Value + 1) And .Range("D" & i).Value = .Range("D" & i - 1).Value Then
.Range("A" & i).EntireRow.Insert shift:=xlDown
.Range("A" & i).Value = .Range("A" & i - 1).Value + 1
.Range("B" & i & ":C" & i).Value = "N/A"
.Range("D" & i).Value = .Range("D" & i - 1).Value
Else
i = i + 1
End If
Wend
End With
End Sub

VBA Macro copy and paste to a specific place based on cell values

#ShaiRado helped me rework a macro to allow me to copy and paste info from my main sheet "Tracker" to a dashboard I'm building "Sheet1" if the status of column J is either "complete" "In progress" or "Upcoming".
It works great - but what I would really like is the information to be pasted to discrete separate locations based on the status of column J. As an example, what I mean by that is; I would like all of the "complete" rows to sit together eg A1:A50, all of the upcomings to sit in A60:A100 and all of the "in progress" to sit in A101:A150, or even going across A-K, M-S, U-AC something like that?
Here is what I have so far:
Option Explicit
Sub Copybasedonstatus()
'Niall McCracken 12/12/16
Dim lRow As Long, cRow As Long, j As Long
With Sheets("Tracker")
lRow = .Range("A800").End(xlUp).Row
' another method of finding last row in Column A (skipping blank cells in the middle)
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For j = lRow To 1 Step -1
cRow = Sheets("Sheet1").Range("A800").End(xlUp).Row
Select Case .Range("J" & j).Value
Case "Upcoming"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)
Case "Complete"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)
Case "In Progress"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Range("A" & cRow + 1)
End Select
Next
End With
End Sub
We can change the cases to find the next available row in the columns you suggest:
Case "Upcoming"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row + 1, "A")
Case "Complete"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "M").End(xlUp).Row + 1, "M")
Case "In Progress"
.Range("A" & j & ":K" & j).Copy Destination:=Sheets("Sheet1").Cells(Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "U").End(xlUp).Row + 1, "U")

SUM the values that appear multiple times into one row

I have a sheet:
I am trying to write code to be able to combine multiple values into one row, I need to sum the values from columns, B, C and D.
My aim is to be able to press a button and I have all of my duplicate values removed, but before this, the numerical values in the adjacent columns are summed into the single version.
So far I have removed the duplicates from the column:
Sheets("Sheet4").Select
With Columns("A:A")
.Replace What:="mobile", Replacement:=""
End With
Previous code should do your job. It may need a fine tuning but idea would work. Do not forget to make proper addressing of worksheets for your ranges. I did not do it. This will work on the active sheet currently.
Update: Updated with worksheet addresses.
Dim ws As Worksheet
Dim LastRow As Long
Dim S_Value As String
Set ws = Sheets("Sheet1")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 2
While i <= LastRow
S_Value = ws.Range("A" & i).Value
j = i + 1
While j <= LastRow
If ws.Range("A" & j).Value = S_Value Then
ws.Range("B" & i).Value = ws.Range("B" & i).Value + ws.Range("B" & j).Value
ws.Range("C" & i).Value = ws.Range("C" & i).Value + ws.Range("C" & j).Value
ws.Range("D" & i).Value = ws.Range("D" & i).Value + ws.Range("D" & j).Value
ws.Rows(j & ":" & j).EntireRow.Delete
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
j = j - 1
End If
j = j + 1
Wend
i = i + 1
Wend
Here you go,
Sub SumCount()
Dim s, c, sm
Dim Rws As Long, Rng As Range
Rws = Cells(Rows.Count, "B").End(xlUp).Row
Set Rng = Range(Cells(2, 2), Cells(Rws, 4))
s = InputBox("What Number to Find?")
c = Application.WorksheetFunction.CountIf(Rng, s)
sm = s * c
MsgBox sm
End Sub

Resources