I have an excel with three columns and three rows like below:
Field1,Field2,Field3
Row1Value1,Row1Value2,Row1Value3
Row2Value1,Row2Value2,Row2Value3
Row3Value1,Row3Value2,Row3Value3
I want to write a VBA Macro to generate an output like below:
Field1=Row1Value1,Field2=Row1Value2,Field3=Row1Value3
Field1=Row2Value1,Field2=Row2Value2,Field3=Row2Value3
Field1=Row3Value1,Field2=Row3Value2,Field3=Row3Value3
Is there an easy way to do this?
Yes you could do it very simply in VBA (we can help you out after you've shared an attempt). If you just want the end result, it would be quicker for you to do with a basic (non-VBA) formula in the sheet.
= A$1 & "=" & B1 & "," & A$2 & "=" & B2 & "," & A$3 & "=" & B3
(Assuming your top left cell in the table is A1)
Think I got it working:
Sub Transform()
Dim i As Integer, j As Integer
For i = 2 To Worksheets("Input").UsedRange.Rows.Count
Dim row As String
row = ""
For j = 1 To Worksheets("Input").UsedRange.Columns.Count
row = row & Worksheets("Input").Cells(1, j) & "=" & Worksheets("Input").Cells(i, j) & ","
Next j
Worksheets("Result").Cells(i, 1) = Left(row, Len(row) - 1)
Next i
End Sub
Related
I need to perform many VLookup in a set of excel files, and for that I built a tool that can make automated VLookup from a file to another but I need to be make it scalable and adaptable.
For that, I want to input in some cells of the tool (which is an Excel file) the parameters for the VLookup:
Position of Key Column
Position of "Returned Value" Column
Number of Columns in the range
Do you know how to change my tool in order for it to include these entry parameters ?
a sample of the code here:
For myrow = 3 To lastrow
Range("b" & myrow).FormulaR1C1 = _
"=VLOOKUP(RC[-1], Input!C[-1]:C[2],2,FALSE)"
Next myrow
I'm not well versed in R1C1 notation, but if you were using regular .Formula notation:
The following code assumes that A1 = Key column, A2 = Returned value column, A3 = Number of columns in the range (which is really just your return column).
lastrow = 10 just for the example
Also note - you must be missing a field... since you should have 4 variables - key column for first parameter, 2 column letters for second parameter, and the number of columns for 3rd parameter.
Sub Test()
lastrow = 10
For myrow = 3 To lastrow
'Range("B" & myrow).Formula = "=VLOOKUP(" & Range("A1").Value & myrow & ",Input!$" & Range("A1").Value & ":$" & Range("A2").Value & "," & Range("A3").Value & ",FALSE)"
Debug.Print "=VLOOKUP(" & Range("A1").Value & myrow & ",Input!$" & Range("A1").Value & ":$" & Range("A2").Value & "," & Range("A3").Value & ",FALSE)"
Next myrow
End Sub
Values on ActiveSheet:
Immediate window returns:
I want to create a macro that check all the cells of a column and if the first two characters of a cell is "BB" then i want the macro to extract three characters from the cell and paste it to the next column but a the corresponding row.
But my formula after the if clause is not working.
this is what i have done since:
Sub test()
Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, icount As Integer
lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
srange = "G1:G" & lastrow
SelData = "A1:G" & lastrow
Range(srange).Formula = "=mid(E1,1,3)"
For i = 1 To lastrow
If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
Range("G" & i).Formula = "=mid("E & i", 4, 3)"
End If
Next i
End Sub
thanks in advance
Try with below. It will work
Range("G" & i).Value = Mid(Range("E" & i), 4, 3)
If the cell is not limited to 7 then you need as below
Range("G" & i).Value = "=Mid(E" & i & ", 3, " & Len(E & "& i & ") & ")"
It will extract from the 3rd character up to the last character in a cell.
Your syntax is wrong where you're trying to concatenate strings, I think you mean to use:
Range("G" & i).Formula = "=MID(E" & i & ",4,3)"
Based on your code I think this will do the exact same thing without having to loop or declare any variables:
Sub test()
With Range("G1:G" & Cells(Rows.Count, 2).End(xlUp).Row)
.FormulaR1C1 = "=IF(UPPER(LEFT(RC[-2],2))=""BB"",MID(RC[-2],4,3),"""")"
.Value = .Value
End With
End Sub
I'm trying to write a VBA script. This script would read 1 column and write the result in another column.
If the values are in bold or if is not blank, I would like to write the data in the column b1.
But if the values are not in bold, I would like to write the data in c1, and concatenate if I have 2 or more non-bold data in the same cell.
My code :
Sub Phone()
Dim valueLogon As String
Dim ValueDevice As String
Dim compteur As Integer
compteur = 1
For i = 1 To 2101
valueLogon = Range("A" & i)
If Range("A" & i).Font.bold = True And IsEmpty(valueLogon) = False Then
compteur = compteur + 1
Range("C" & i) = valueLogon
Else
Range("D" & compteur) = valueLogon & "," &
End If
Next i
End Sub
now, my result is like to the picture, but I would like concactenate the non-bold result in the same cell
change
Range("D" & compteur) = valueLogon & "," &
to
Range("D" & compteur).Value = valueLogon & "," & Range("D" & comptuer).Value
I'm trying to create a macro that will group data by month: for example, if there are 3 entries for February for client A, then it will consolidate the three entries into one and sum the amounts.
I have:
A: Client name
B: Invoice number
C: Billing month
D: Currency
E: Charge amount
F: Invoice step
What I am trying to do, is group the following into a single row, with the invoice amounts added up, and replace the three rows with just the one row. These entries are for a single client (so the grouping depends on the value in column A).
EG. Client A has three entries for Jan, Client B has one, Client C has one. Then for February Client A has one, Client B has one and Client C has two.
Any macro suggestions I've seen on here haven't been helpful to me, I keep getting errors coming up so I don't know what the problem is. This is the one I tried:
Sub Group()
Dim e As Range, a as Range
Set e = Range("C6")
Set c = e.Offset(, 2)
Do
If Evaluate("=month(" & e.Address & ")") <> Evaluate("=month(" & e(2).Address & ")") Then
e(2).Resize(2, 3).Insert
e(2).Offset(, 2) = "=sum(" & Range(a, c.Offset(, 2)).Address & ")"
e(2).Offset(, 2).Font.Bold = 1
Set e = e.End(4)
Set c = e.Offset(, 2)
Else
Set e = e(2)
End If
Loop Until e.End(4).Row = Rows.Count
e(2).Offset(, 2) = "=sum(" & Range(c, e.Offset(, 2)).Address & ")"
e(2).Offset(, 2).Font.Bold = 1
End Sub
EDIT: Subtotals and pivot tables would not work - the raw data is pasted in (thousands of lines of entry, for 40+ clients and some have many invoices each month), the raw data is sorted using a macro, which is then pasted into other sheets. Pasting from the pivot would be more difficult.
I follow your image to write the code:
After the code:
Here is the code:
Sub TEST()
Dim lastrow As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To lastrow
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For j = i + 1 To lastrow
If Range("A" & j) = Range("A" & i) And Range("C" & j) = Range("C" & i) Then
Range("B" & i) = Range("B" & i) & "," & " " & Range("B" & j)
Range("E" & i) = Range("E" & i).Value + Range("E" & j).Value
Rows(j).EntireRow.Delete
End If
Next j
Next i
End Sub
I have a loop that runs through the worksheet and keeps track of works where the guy is named "bill" then memorizes those rows and i want to copy them over to the next sheet.
my problem is that
'works
'Range("525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129").Select
but when i use a variable to create that list of rows, it doesnt select the rows
Dim accountsArray(2, 2) As String
accountsArray(1, 0) = "test"
accountsArray(1, 1) = "bill"
Dim rngCounter As String
rngCounter = Chr(34)
For i = ActiveSheet.Cells(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, 1).Row To 2 Step -1
'save rows with bill
If InStr((ActiveSheet.Cells(i, 2).Text), accountsArray(1, 1)) <> 0 Then
If Len(rngCounter) < 2 Then rngCounter = rngCounter & i & ":" & i Else rngCounter = rngCounter & "," & i & ":" & i
End If
Next i
rngCounter = rngCounter & Chr(34)
'works
'Range("525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129").Select
'does not work
Range(rngCounter).Select
Selection.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste
The way the code currently is written you're effectively calling this:
Range("""525:525,504:504,502:502,497:497,496:496,495:495,494:494,493:493,492:492,491:491,478:478,471:471,453:453,450:450,449:449,448:448,447:447,446:446,445:445,444:444,443:443,442:442,441:441,440:440,439:439,438:438,437:437,436:436,427:427,129:129""").Select
So take out the Chr(34) (double quotes) that you are adding to the beginning and end of your string and it'll work fine.