I have a downloaded bank statement on SHEET1 (ALL).
I have several widgets running along the side one of which
=SUMIF(C:C,H3,D:D)
Searches the Descriptions for the value in H3 (EG: * WAGES *) and totals up the corresponding value in D.
I now need to expand that so that it copies the entire ROW onto a new Spreadsheet.
I'd also like, if possible, to start with an input box so I can search for multiple things at once.
Various code that I have seen / tried will only work for exact values in Row C. But with the bank statement its never the same twice and I'd like it to wildcard the search if possible.
Thanks for your time.
Kind Regards
Alex Nicol
I have recently written VBA code just like this. Where I use the word payments, you can use the word Wages and include your wildcards like so:
a.Cells(b.Row, 16).Value LIKE "*Wages*"
Sub ShortTerm()
Dim a As Range, b As Range
Dim i As Long
Dim j As Long
Dim p As Long
Dim value1 As Variant
i = 4 'the start row for pasting
Set a = ThisWorkbook.Sheets("Payments").UsedRange
For Each b In a.Rows
'in the next line change 16 to reflect the column where WAGES is found
If a.Cells(b.Row, 16).Value = "Short Term" Then
For j = 1 to 16
value1 = a.Cells(b.Row, j).Value
ThisWorkbook.Sheets("DestinationSheet").Cells(i, j).Value = value1
Next
i = i + 1
End If
Next
End Sub
Obviously I am only copying 16 columns and so if that is all you want, this should work. If you need more, make that loop larger. There is probably a way to copy the whole row, but I had originally only wanted specific cells and I had wanted them reorganized which is why I did it the way I did.
See the post on my blog here:
http://automatic-office.com/?p=355
Related
I have inherited a very large spreadsheet and am trying to migrate it to a database. The table has over 300 columns, many of which reference other columns.
By converting it to a table (ListObject) in Excel, I thought it would be easier to deconstruct the logic... basically turn the formula:
=CJ6-CY6
into
=[#[Sale Price]]-[#[Standard Cost]]
Converting it to a table worked great... unfortunately it didn't change any of the embedded formulas. They still reference the ranges.
I think I may notionally understand why -- if a formula references a value in another row, then it's no longer a primitive calculation. But for formulas that are all on the same row, I'm wondering if there is any way to convert them without manually going into each of these 300+ columns and re-writing them. Some of them are beastly. No joke, this is an example:
=IF(IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6))))>GO6,GO6,IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))))
And it's not the worst one.
If anyone has ideas, I'd welcome them. I'm open to anything. VBA included.
I would never use this to teach computer science, but this is the hack that did the trick. To keep things simple, I transposed header names and the corresponding column into A17:
And then this VBA code successfully transformed each range into the corresponding column property.
Sub FooBomb()
Dim ws As Worksheet
Dim r, rw, translate As Range
Dim col, row As Integer
Dim find, anchored, repl As String
Set ws = ActiveWorkbook.ActiveSheet
Set rw = ws.Rows(6)
Set translate = ws.Range("A17:B363")
For col = 12 To 347
Set r = rw.Cells(1, col)
For row = 363 To 17 Step -1
find = ws.Cells(row, 1).Value2 & "6"
anchored = "$" & find
repl = "[#[" & ws.Cells(row, 2).Value2 & "]]"
r.Formula = VBA.Replace(r.Formula, anchored, repl)
r.Formula = VBA.Replace(r.Formula, find, repl)
Next row
Next col
End Sub
Hard-coded and not scalable, but I'm not looking to repeat this ever again.
-- EDIT --
Word to the wise to help performance, especially with as many columns and formulas are in this spreadsheet.
Set Formula calculation to manual before
Check before the field exists before doing a replacement -- skipping happens more often than not
Program ran in a few seconds (minutes prior) before these changes:
If InStr(r.Formula, anchored) > 0 Then
r.Formula = VBA.Replace(r.Formula, anchored, repl)
End If
If InStr(r.Formula, find) > 0 Then
r.Formula = VBA.Replace(r.Formula, find, repl)
End If
I've scoured the interwebs for any kind of solution and I keep coming up empty so hopefully someone can help me out. I have two sheets, Sheet1 and Inventory. In Sheet1, the user enters the date in B1. In range C4:C200 I have a list of supplies and in range D4:D200 a user enters the number of each of the supplies on hand. In Inventory, the list of supplies is in range A1:A200, and b1:z1 list dates.
I'm trying to create a macro that will look in Sheet1 for the date entered in B1, let's say 4/1/19, copy D4:D200, then look in Inventory, find 4/1/19 in rows b1:z1 and paste the copied data beneath the correct date. So if 4/1/19 is in cell E1, the values would be pasted in E2.
While I'm decent with cell formulas and functions, I'm new to macros, so I'm not sure what to do.. Any help is greatly appreciated!
I tried to write some very basic code in such way you can easily read it. It is not the most sophisticated code but it will do the job. Just a few things i noticed: The number of supplies are in a list 197 long, the sheet Inventory states lists of 200 items...well, you can easily adjust the macro below. Copy past the code in a new module and run it. If you encounter any problems please post the complete workbook and i will have a look. Make sure that cell a1 on inventory is not empty.
Sub DoYourThing()
Dim c As Integer
c = findHorizontal("Inventory", 1, Sheets("Sheet1").Cells(1, 2).Value)
'now we know what column the date is in
For i = 2 To 200
Sheets("Inventory").Cells(i, c) = Sheets("Sheet1").Cells(i + 2, 5)
Next i
End Sub
Function findHorizontal(Sheet As String, row As Integer, Value As Variant) As Integer
'searches a row from left to right until the cells are empty
Dim i As Integer
i = 1
Do While Not IsEmpty(Sheets(Sheet).Cells(row, i))
If Sheets(Sheet).Cells(row, i) = Value Then
findHorizontal = i
Exit Function
End If
i = i + 1
Loop
findHorizontal = -1
End Function
I'm building an Excel sheet to help me with teaching.
My objective is a sheet to create two random numbers, calculate their arithmetic means and geometric means, and compare them. This part I have finished.
I created a macro and two functions that generates random numbers, then input the numbers to the desired cells:
Sheets("Sheet1").Range("L1").Value = NewRandom()
Sheets("Sheet1").Range("M1").Value = NewRandom2()
I created a button to execute the macro.
How could I make a record of what I have been generating, in designated area U7:V200, on the same sheet?
My aim: The first time I click the button, two generated numbers will be recorded on U7 and V7, respectively. The second time I click, two generated numbers will be recorded on U8 and V8, and so on.
The subroutine below will find the next empty row based on the "U" column of your sheet.
XLROW signifies the row in which you want to begin your search for an empty row.
Once the empty row is found, the two random values that you have passed to the subroutine will be entered into the first available empty row.
Make sure to change "Sheet1" to the name, if you have one, of the sheet that you are using in excel.
Public Sub NEXTEMPTY(VAL1 As Integer, VAL2 As Integer)
Dim XLROW As Integer
XLROW = 7
Do Until Sheet1.Range("U" & XLROW) = ""
XLROW = XLROW + 1
Loop
Sheet1.Range("U" & XLROW).Value = VAL1
Sheet1.Range("V" & XLROW).Value = VAL2
End Sub
Then you can just call the sub anywhere you'd like using:
Call NEXTEMPTY(RANDOM1, RANDOM2)
EDIT: You can also use this in the Do Until. This is more preferable.
Do Until IsEmpty(Sheet1.Range("U" & XLROW))
This is just a matter of finding the last row and pasting to it...
dim lr as long
lr = cells(rows.count,"U").end(xlup).row
cells(lr+1,"U").value = randomnumber1
cells(lr+1,"V").value = randomnumber2
Assumes you are always having U/V paired together, so only need 1 last row
I've been trying, unsuccessfully, for weeks to create a macro that loops through rows of text and identifies variable text phrases to sort products by there underlying components. That text phrase will be located in different spots across the page or linked with multiple other variables. For example how many products in a list contain "leather" and identify that in an answer row next to the list with a defined phrase like "Absolutely". The code I've been working with looks like this:
Sub Find()
Dim Sheet As Worksheet
Dim rng As Range
Dim row As Range
Dim cell As Range
Set Sheet = ActiveSheet
Set rng = Sheet.Range("E2:J7")
For Each row In rng.Rows
For Each cell In row.Cells
Select Case cell.Value
Case "Oil"
Case "Leather"
Cells(row.row, 11).Value = "Absolutely"
Case "Absolutely"
Case "Nope"
Case Else
Cells(row.row, 11).Value = "Nope"
End Select
Next cell
Next row
End Sub
And the Table would look look this:
Currently the code runs through the correct lines and sees all of the components but fails to identify the answers in the answer row. I'm using this code to hopefully identify many variable components in many product lists and "Leather" and "Oil" are currently just place holders. Hopefully this will help myself and many other people avoid reading long lists of data and marking individually whether or not each item meets a certain defined criteria.
Does this have to be VBA? You could easily do this with the COUNTIF function. Using your provided sample data, in cell D10 use this formula and copy down:
=IF(C10="","",IF(COUNTIF($2:$7,C10)>0,"Absolutely","Nope"))
in my job I have very often to create prefixes. Since last week I think that I can do faster my job with a Macro in excel, but I never have developed in VBA before and need your help.
We get a list with article numbers from any supplier and then I have to create the prefixes for our System. Our System is looking for the prefix and then it knows the supplier. If the first 6 chars are exactly the same with another supplier, so the prefixes from both supplier is getting longer to 7 chars. If it's the same again, the prefix is getting an eight char and so on.
Example:
article numbers from supplier_1:
04012384724993
04012384473373
04012384111453
...
article numbers from supplier_2:
12345671846219
12345629946120
12345629815294
...
article numbers from supplier_3:
12345694724109
12345694715268
12345694724773
...
Now you see that first chars from each supplier are the same.
For Supplier_1 all numbers beginning with "040123", so that's the first prefix.
Supplier_2 ans 3 have the same first 6 chars, so here we use one more to identificate him.
Supp_2 -> "1234567" and "1234562"
Supp_3 -> "1234569"
Supplier_2 have now 2 prefixes, because the 7th position is different in some article numbers, but not the same like supplier_3 is using at this position.
Now I have an excel sheet with column A and B.
In column A I paste all article numbers from supplier_1 and in column B I paste these from supplier_2.
Now I want to run a macro, that create a variable "search" with the first 6 chars from Cell A1 and check it against Column B. If one of the numbers in Column B is the same then variable "search" get additional the next char from Cell A1 and check again. If now the first 7 chars couldn't be found in Column B, it's the first prefix from supplier_1. I want to paste it into column D.
Now the variale "search" get the first 6 chars from the next Cell in column A, (A2), later A3, ... and check it against Column B.
I don't know, how to get the first 6 chars into the variable "search".
Can someone help me please?
Thank you very much.
It is always a good idea to approach big problems in as small chunks as possible. Indeed, it may be a good start to assign the first few characters of a string to a variable. A quick Google search would most likely point you to the Left function. Here's a link to the MSDN page for more information on how it works and how to use it.
I also suggest that you enable the Immediate Window, which can be done with Ctrl + G by default. Using Debug.Print will be one of your strongest tools while writing new code.
Sub Example1()
Dim searchRange As Range
Dim search As String
Set searchRange = ThisWorkbook.Worksheets("Sheet1").Range("A1")
search = Left(searchRange.Value, 6)
Debug.Print search
End Sub
Here's a snippet to give you an idea of how you might go about solving the next step of the problem.
Sub Example2()
Dim compareRange As Range
Dim cell As Range
' SpecialCells is one of many ways to find all populated cells
Set compareRange = ThisWorkbook.Worksheets("Sheet1").Columns(2) _
.SpecialCells(xlCellTypeConstants)
For Each cell In compareRange
Debug.Print cell.Value
Next
End Sub
Please remember that StackOverflow is here to help with specific coding problems that you can't get over with the resources you can find online.
I had some difficulty deciphering exactly what you needed but here is what I have come up with.
I am going to assume that you know how to insert a module into your excel spreadsheet, copy code, and run a macro. If you do not know how please let me know and I will try to assist further.
If this is not what you need please provide me with a sample data set and the answers that you would like to get from the macro so that I can compare as I develop. Best of luck with your projects!
VBA module code
'This subroutine will take the contents of column A cells and search column B for matching digits
' if they are not found it will copy the current search term into column D
Option Explicit
Sub searchPrefix()
Dim cellContents As String
Dim tempSearchVariable As String
Dim isFound As Boolean
Dim quantitySearchCharacters As Integer
Dim entryCounter As Integer
Dim i As Integer
isFound = False
quantitySearchCharacters = 6
entryCounter = 0
'counts number of entries in column A
Cells.Range("A1").Select
Do Until IsEmpty(ActiveCell)
entryCounter = entryCounter + 1
ActiveCell.Offset(1, 0).Select
Loop
' gets value of comparison cell in column A
For i = 0 To entryCounter - 1
cellContents = Cells(1 + i, 1).Value
tempSearchVariable = Left(cellContents, quantitySearchCharacters)
Cells.Range("B1").Select
Do Until IsEmpty(ActiveCell)
' detects if B1 column cell content matches the current search terms and then adds more characters if required
If Left(ActiveCell.Value, quantitySearchCharacters) = tempSearchVariable Then
quantitySearchCharacters = quantitySearchCharacters + 1
tempSearchVariable = Left(cellContents, quantitySearchCharacters)
isFound = True
End If
If isFound Then
isFound = False 'reset flag
Cells.Range("B1").Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Cells(1 + i, 4).Value = tempSearchVariable ' prints the discovered unique prefix to column D
Next i
End Sub