Excel adding values from columns that start with the same word? - excel

My colleagues at work seem to spend a lot of time getting data from spreadsheets and having to work out percentages then paste it into a report.
I'm pretty sure there is a quicker way but it's proving difficult with little experience with Ecxel.
Excel Spreadsheet
I have already created a Macro to remove any unnecessary text in the fields so it is now just a value.
My problem is that there is always a different number of fields that I need to get data from.
The field I need the values from is the one directly under any field that starts with "Unique Pulls" Once I can work this out, the rest should be pretty straight forward.

I'm just starting out with VBA myself so not 100% sure, but perhaps you could use a Find/FindNext loop?
This might be helpful on using Find/FindNext (example in 'Section 3'): http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/
Hope that helps with getting you started!
edit:
Maybe you've already solved this from the comments above, but in case you are still having issues with adding up values here's a potential solution I've been playing with: all credit to #Alex K. for the UCase$(cell.Value) suggestion above!
Dim LastRow As Integer, LastCol As Integer
Dim iTotal As Integer, n As Integer, i As Integer
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
For n = 2 To LastRow ' For each row with data...
iTotal = 0 ' Resets total count for each row.
For i = 1 To LastCol ' Find each column starting with 'Unique Pulls'.
If UCase$(ActiveSheet.Cells(1, i).Value) Like "UNIQUE PULLS*" Then
iTotal = iTotal + ActiveSheet.Cells(n, i).Value
' For each of these columns, take value and add to total sum
End If
Next i ' Move onto next column
ActiveSheet.Cells(n, 5).Value = iTotal
'REPLACE 5 WITH COLUMN NUMBER OF TOTAL PULLS
Next n ' Move onto next row
Perhaps?

This looks at each header in A:A and msgboxes the value under any cell beginning with your search text:
Dim cell As Range: Set cell = Range("A1")
Do While cell.Value <> ""
If UCase$(cell.Value) Like "UNIQUE PULLS*" Then
MsgBox cell.Offset(1, 0).Value
End If
Set cell = cell.Offset(0, 1)
Loop

Related

match against previous entries in column, copy the rest of data in the row

I am trying to make a vba code that will allow quicker entry of possible repeated data. In my example, I am trying to get the entries in the H column to check if that stock number has already been entered. If so, copy the data from column I - column M of the matched row to column I - column M of the blank "new entry" row.
Here is one of my attempts at the code
Private Sub finddata()
Dim stock As Integer
Dim finalrow As Integer
Dim i As Integer
finalrow = Sheet1.Range("H50").End(xlUp).Row
For i = 2 To finalrow
stock = Sheet1.Cells(i, 8).Value
If Cells(i, 8) = stock Then
Range(Cells(i, 9), Cells(i, 13)).Copy
Range("I50").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
Next i
End Sub
Any advice would be awesome, I cannot use vlookup directly in excel,the cells need to remain empty so data can be input if no match was found.
Thanks!!
Matt.
I've been playing with your macro and a dummy dataset similar to yours.
I've made a few modifications to your code that allowed me to get the result you're looking for:
Private Sub finddata()
'Dim stock As Integer
Dim finalrow As Integer
Dim i As Integer
'Modified:
finalrow = Sheet1.Range("H1").End(xlDown).Row
For i = 2 To finalrow - 1
For j = 3 To finalrow
stock = Sheet1.Cells(j, 8).Value
If Cells(i, 8) = stock Then
Range(Cells(i, 9), Cells(i, 13)).Copy
'Modified line:
Sheet1.Range("I" & j & ":M" & j).PasteSpecial Paste:=xlPasteValues
End If
Next j
Next i
Application.CutCopyMode = False
End Sub
As you can see, first of all I removed the Dim declaration of the stock variable. It was raising an error when overwriting the value.
Second of all, instead of searching upwards from the bottom of the table, I search from H1 all the way to the last used row, for optimization.
Most important, I've nested another for inside your for, checking every other stock number on the column.
Then, I checked the last line inside the If block. I'm not really sure what you were trying to do, as I don't fully get that line on your code. But I tried with my method and it worked.
The result was: Every stock number that had a match in a previous row will have the same values on columns I through M on that row
Before executing macro:
After executing:
I'm not sure if that's exactly what you're aiming for, but it's a start.
I'm sure this Macro will have to be implemented on a listener or button for easier use.
Hope it helps.

Remove all character after nth character

I am working on some data organization and need to move information into a form. I have a column of IP addresses and some columns have more than one, or even none. I preferably need to be able to go through the column and keep the first 13 characters and remove everything after it, have 581 lines I need it to be able to run through. I think if I could get a VBA that will run through the column and find the first "," and remove that and anything after it will work. I tried this, but it did nothing.
Sub cleanup()
lastrow = Range("G581").End(xlUp).Row
For i = 2 To lastrow
If Len(Cells(i, 1)) > 13 Then
Cells(i, 1) = Left(Cells(i, 1), 14)
End If
Next i
End Sub
As mentioned before, you are counting the rows in column G, hopefully column G and Column A have the same number of rows.
I'm thinking column G may be the issue.
lastrow = Range("A581").End(xlUp).Row
For i = 2 To lastrow
If Len(Cells(i, 1)) > 13 Then
Cells(i, 1) = Left(Cells(i, 1), 14)
End If
Next i
Honestly there could be a few reasons that you're having trouble. The big one is that when you use the Left() function, you tell it to keep 14 characters instead of the 13 you said that you want!
Another option could be that excel thinks you are trying to do this operation on another sheet. To combat this one, I made a worksheet object and qualified all of the ranges mentioned just to be sure that excel knows what location you're talking about.
An (unlikely based on your description, but possible) problem could be with the way that you specify the lastrow. If you have a column of contiguous values (although your description would suggest you do not) and you specify the last row of that column with a value, the .End(xlUp) will actually trace back up to the last cell with no value which could be the first row - so the loop never even runs! You could avoid this just by changing it to lastrow = Range("G582").End(xlUp).Row (one row below what you know to be the last full row), but why bother when you can just let excel do the work for you like in my answer below.
Sub cleanup()
Dim ws As Worksheet
Set ws = sheets("Sheet1")
Dim lastRow As Long
lastRow = ws.Range("G" & rows.count).End(xlUp).row
Dim i As Long
For i = 2 To lastRow
If Len(ws.Cells(i, 1)) > 13 Then
ws.Cells(i, 1) = Left(ws.Cells(i, 1), 13)
End If
Next i
End Sub
I also made a version with the second option that you mentioned in the question about splitting each row by a comma ",".
Sub cleanup2()
Dim ws As Worksheet
Set ws = sheets("Sheet1")
Dim lastRow As Long
lastRow = ws.Range("G" & rows.count).End(xlUp).row
Dim i As Long
For i = 2 To lastRow
ws.Cells(i, 1) = Split(ws.Cells(i, 1), ",")(0) 'option 2
Next i
End Sub
Hope this solves your problem!

Creating a print button based on conditional criteria in Excel

So first my disclaimer. While I have some programming background, im not proficient in VB scripting so I may need some hand holding on this but I am mighty grateful for any help you wonderful people can render.
Im creating a print button that will print a worksheet based on criteria that the user will type in. Well basically I need the script to check certain cells in a row and if there is data in those cells, move to the next line. Rinse and repeat until you get to a row with no data in those certain cells and then automatically print the correct number of pages based on the data. I hope that makes sense. I hope that makes sense.
I tried writing a piece of code to check certain columns and return the value when all of those columns are blank. Hope that helps you
Sub Printing()
Dim CheckCol1 As Integer, CheckCol2 As Integer
Dim rowCount As Integer, rowCount1 As Integer, rowCount2 As Integer, currentRow As Integer
Dim currentRowValue1 As String, currentRowValue2 As String
Dim found As String
found = "No"
CheckCol1 = 1 'column A has a value of 1
CheckCol2 = 2 'column B has a value of 2
rowCount1 = Cells(Rows.Count, CheckCol1).End(xlUp).Row
rowCount2 = Cells(Rows.Count, CheckCol2).End(xlUp).Row
rowCount = Application.Max(rowCount1, rowCount2)
' find the first blank cell on both the columns
For currentRow = 1 To rowCount
currentRowValue1 = Cells(currentRow, CheckCol1).Value
currentRowValue2 = Cells(currentRow, CheckCol2).Value
If (IsEmpty(currentRowValue1) Or currentRowValue1 = "") And (IsEmpty(currentRowValue2) Or currentRowValue2 = "") Then
MsgBox ("No data on Column A and B in row" & currentRow)
found = "Yes"
End If
Next
If found = "No" Then ' This will return rowcount+1 when the columns have values throughout the range
MsgBox ("No data on Column A and B in row" & rowCount + 1)
End If
End Sub
Note:- You can increase the number of columns to be checked by adding few variables. You can try Adding third column by adding Checkcol3, rowcount3, currentrowvalue3 and adding one more condition to the if clause

Excel VBA: How to find duplicates and transpose?

I would like to ask your help for this task.
The excel sheet contains duplicated items in ColumnA. I want to combine these duplicates into one row. Please see the picture.
As the actual picture shows, there are three As in ColumnA. For every A there are some cells from ColumnB. Lets say those are the values to A. The values from every rows are marked with different colors seperately.
I want to combine A's values into one row, as the target picture shows.
The excel sheet was pre-sorted, so that all duplicates from ColumnA always appear together.
Please be noticed there are also items without duplicates: There is only one E in ColumnA. No transpose is required for this row.
Please also be noticed that there could be more duplicted items in ColumnA. E.g. 10x Ts, or 30x Ks.
To make the task easier, it is no need to delete the blank rows after the transformation.
The colors are used only to show the problem, there is no color in the excel sheet.
So far for this task.
Actually I asked a similar question before: Excel VBA: How to transform this kind of cells?
In the link there are some very good codes, but sadly I am not capable to rewrite the code for this task.
So please help me~
But please dont forget to have a happy weekend~
Thanks!
Try the code below ("bonus" feature, also removes the empty rows).
As you wrote in your post, the data is sorted according to Column A, and there are no empty rows in your data.
Sub TransposeDup()
Dim LastCol, LastColCpy As Long
Dim lrow As Long
lrow = 1
While Cells(lrow, 1) <> ""
If Cells(lrow, 1) = Cells(lrow + 1, 1) Then
LastCol = Cells(lrow, Columns.Count).End(xlToLeft).Column
LastColCpy = Cells(lrow + 1, Columns.Count).End(xlToLeft).Column
Range(Cells(lrow + 1, 2), Cells(lrow + 1, LastColCpy)).Copy Destination:=Cells(lrow, LastCol + 1)
Rows(lrow + 1).EntireRow.Delete
Else
lrow = lrow + 1
End If
Wend
End Sub
Something like the following should get you in the right direction. This doesn't copy formats, but it gets the values. You could tweak it to get where you need to go though:
Sub dedup_and_concat()
Dim intWriteCol As Integer
Dim intReadCol As Integer
Dim intWriteRow As Integer
Dim intReadRow As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim strPrevRowValue As String
'Start and end rows:
intStartRow = 1
intEndRow = 8
'initial values:
intWriteRow = 1
'Loop from your start row to your end row
For intReadRow = intStartRow To intEndRow 'beginning and ending rows
intReadCol = 2
'If we are at the first row, then just capture values
'Also if this is a new value, then reset all of the write variables
If intReadRow = intStartRow Or Sheet1.Cells(intReadRow, 1).Value <> Sheet1.Cells(intWriteRow, 1).Value Then
'set the row and initial column we are writing to
intWriteRow = intReadRow
intWriteCol = Sheet1.Cells(intReadRow, 1).End(xlToRight).Column() + 1
Else
'We are on a row that needs to be concatenated and deleted
'So loop through all of the columns to get their values
'And write their values to the read row and read col
Do Until Sheet1.Cells(intReadRow, intReadCol).Value = ""
Sheet1.Cells(intWriteRow, intWriteCol).Value = Sheet1.Cells(intReadRow, intReadCol).Value
'increment read and write columns
intWriteCol = intWriteCol + 1
intReadCol = intReadCol + 1
Loop
'remove this rows values
Sheet1.Rows(intReadRow).ClearContents
End If
Next intReadRow
End Sub

Select/Highlight column range (A-L) for every specific cell values ('Apple') in every row

I'm trying to find an easy way to get rid of 'bad' rows in my worksheet, which has 3780 rows. Instead of scanning through and deleting each rows every time, which is time consuming, I was wondering if there was an easier way?
Perhaps by making a macro that highlights cells in a column range (A-L) every time it finds the bad value (e.g. 'Apple') in a cell located in every row.
Something along the lines of:
If =ISTEXT() then delete row
I hope this makes sense, let me know if not.
This small macro will search for the presence of apple in any cell in columns A through L and delete that row:
Sub KillBadApple()
Dim rng As Range
Set rng = Intersect(ActiveSheet.UsedRange, Range("A:L"))
nLastRow = rng.Rows.Count + rng.Row - 1
nFirstRow = rng.Row
For i = nLastRow To nFirstRow Step -1
exam = ""
For j = 1 To 12
exam = exam & Chr(1) & Cells(i, j).Text
Next j
exam = LCase(exam)
If InStr(exam, "apple") > 0 Then
Cells(i, j).EntireRow.Delete
End If
Next i
End Sub

Resources