How to map a cell value to another cell with IF condition - excel

Suppose I have a table like this in excel -
+-------------+----------+------------+
| Google Name | D11 Name | Entry |
+-------------+----------+------------+
| REN | MLR | |
| THU | SDT | |
| SIX | SDS | |
| HOH | HBH | |
| STR | ADS | |
| HEA | BRH | |
| PRS | PS | |
| STA | MLS | |
+-------------+----------+------------+
Now I will enter something in Entry column. If the value matches with Google Name value it should change to corresponding D11 Name value. Which means this -
+-------------+----------+------------+
| Google Name | D11 Name | Entry |
+-------------+----------+------------+
| REN | MLR | SIX -> SDS |
| THU | SDT | |
| SIX | SDS | |
| HOH | HBH | |
| STR | ADS | |
| HEA | BRH | |
| PRS | PS | |
| STA | MLS | |
+-------------+----------+------------+
If I enter SIX final entry will be SDS, -> is for explaining purpose only.

If you want to change a typed input to a values retrieved from a lookup, you need VBA and a Worksheet_Change event driven sub procedure.
Open the worksheet's private code sheet (right-click worksheet name tab and View Code) then paste in this code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
On Error GoTo sub_exit
Application.EnableEvents = False
Dim t As Range, m As Variant
For Each t In Intersect(Target, Range("C:C"))
m = Application.Match(t.Value2, Range("A:A"), 0)
If Not IsError(m) Then
t = Cells(m, "B").Value2
End If
Next t
End If
sub_exit:
Application.EnableEvents = True
End Sub

Related

Trying to sum values in a row using VBA and can't solve a bug in code

I have written some VBA to sum the values across columns in a row. I have found however that when i run the code it receives a type mismatch error on random rows and i cannot figure out why. When i delete all other columns except from the four that are to be added it suddenly does not have this error?
I've also noticed that for some reason it does not add the "serving player backhand" column value as it should and i can't figure out why.
Sub sumShotsInRally()
'Set rawData sheet as active
Dim sht1 As Worksheet
Set sht1 = Sheets("Input")
sht1.Activate
'Find the Columns to Add
Dim serverForehandColNum As Integer
serverForehandColNum = ActiveSheet.Rows(1).Find(what:="Serving player forehand", lookat:=xlWhole).Column
Dim serverBackhandColNum As Integer
serverBackhandColNum = ActiveSheet.Rows(1).Find(what:="Serving player backhand", lookat:=xlWhole).Column
Dim returnerForehandColNum As Integer
returnerForehandColNum = ActiveSheet.Rows(1).Find(what:="Returning player forehand", lookat:=xlWhole).Column
Dim returnerBackhandColNum As Integer
returnerBackhandColNum = ActiveSheet.Rows(1).Find(what:="Returning player backhand", lookat:=xlWhole).Column
'Insert two new columns for the x and y
ActiveSheet.Columns(serverForehandColNum + 1).Insert
' Add New col headings
ActiveSheet.Cells(1, serverForehandColNum + 1).Value = "Rally Count"
Dim rallyCountColNum As Integer
rallyCountColNum = ActiveSheet.Rows(1).Find(what:="Rally Count", lookat:=xlWhole).Column
'Split the cell values
'Define the range to iterate over as the used range of the found column
Dim SForehandRange As Range
Dim SBackhandRange As Range
Dim RForehandRange As Range
Dim RBackhandRange As Range
Dim rallyRange As Range
With ActiveSheet
Set SForehandRange = .Range(.Cells(2, serverForehandColNum), .Cells(.UsedRange.Rows.Count, serverForehandColNum))
Set SBackhandRange = .Range(.Cells(2, serverBackhandColNum), .Cells(.UsedRange.Rows.Count, serverBackhandColNum))
Set RForehandRange = .Range(.Cells(2, returnerForehandColNum), .Cells(.UsedRange.Rows.Count, returnerForehandColNum))
Set RBackhandRange = .Range(.Cells(2, returnerBackhandColNum), .Cells(.UsedRange.Rows.Count, returnerBackhandColNum))
Set rallyRange = .Range(.Cells(2, rallyCountColNum), .Cells(.UsedRange.Rows.Count, rallyCountColNum))
End With
Dim results()
'You redimension the results array to the number of entries in your table
ReDim results(1 To SForehandRange.Rows.Count)
'You loop over your table and sum the values from count and restocked
For i = 1 To SForehandRange.Rows.Count
rallyRange(i, 1).Value = SForehandRange(i, 1).Value + SBackhandRange(i, 1).Value + RForehandRange(i, 1).Value + RBackhandRange(i, 1).Value
'results(i) = SForehandRange(i, 1) + SBackhandRange(i, 1) + RForehandRange(i, 1) + RBackhandRange(i, 1)
Next i
'You write the array to the range count and delete the values in restocjed
'rallyRange = Application.Transpose(results)
End Sub
A sample of the table:
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
| Name | Position | Duration | 1st serve outcome | 1stReturnLocation | 1stServeLocation | 1stServeXY | 2nd return outcome | 2nd return stroke | 2nd serve outcome | 2ndReturnXY | 2ndServeLocation | 2ndServeXY | Date | Final shot outcome | Game score | Opponent player | Point score | Point won by | S/R | Set score | Side | Tagged player | Tiebreak score | Tournament name | 1st return outcome | 1st return stroke | 1stReturnXY | 2nd return+1 outcome | 2nd return+1 position | 2nd return+1 situation | 2nd return+1 stroke | 2nd serve+1 outcome | 2nd serve+1 position | 2nd serve+1 situation | 2nd serve+1 stroke | 2ndReturn+1XY | 2ndReturnLocation | 2ndServe+1XY | Final hit | Final shot position | Final stroke | FinalShotXY | Returning player forehand | Serving player forehand | Type | 1st serve+1 outcome | 1st serve+1 position | 1st serve+1 situation | 1st serve+1 stroke | 1stServe+1XY | 1st return+1 outcome | 1st return+1 position | 1st return+1 situation | 1st return+1 stroke | 1stReturn+1XY | Tagged net approach | Returning player backhand | Serving player backhand | Opponent net approach |
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
| 0-0 (1) | 329720 | 23520 | Error | Error net | Error net | 38;52 | Error | Forehand | In | 65;54 | Wide | 32;38 | 20/08/2011 | Forced error | 00:00 | Player 2 | 0-0 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 15-0 (1) | 375000 | 4720 | In | Error long | Body | 60;32 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | 15-0 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | Error | Backhand | 65;5 | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 30-0 (1) | 393320 | 17440 | Error | | Error net | 44;51 | In | Forehand | In | 57;27 | Body | 42;34 | 20/08/2011 | Unforced error | 00:00 | Player 2 | 30-0 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | | | | In | Middle baseline | Neutral | Backhand | In | Middle baseline | Neutral | Forehand | 59;28 | Middle | 61;27 | Player 1 | Middle baseline | Forehand | 39;28 | 1 | 1 | Ground stroke | | | | | | | | | | | | | | |
| 40-0 (1) | 428640 | 6360 | In | Middle | Wide | 66;36 | | | | | | | 20/08/2011 | | 00:00 | Player 2 | 40-0 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 46;20 | | | | | | | | | | | | | | | | | | | Unforced error | Middle baseline | Neutral | Forehand | 48;29 | | | | | | | | | |
| 40-15 (1) | 450800 | 9840 | In | Middle | Wide | 34;34 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | 40-15 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | In | Forehand | 55;28 | | | | | | | | | | | | Player 1 | Middle transition | Forehand | 69;50 | | 1 | Approach shot | In | Middle baseline | Neutral | Forehand | 57;28 | In | Middle baseline | Neutral | Backhand | 69;23 | Yes | | | |
| 40-30 (1) | 485280 | 6680 | In | Middle | Body | 60;33 | | | | | | | 20/08/2011 | | 00:00 | Player 2 | 40-30 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 59;34 | | | | | | | | | | | | | | | | | | | Unforced error | Middle inside | Neutral | Forehand | 70;36 | | | | | | | | | |
| SD advantage (1) | 523800 | 4880 | In | Error long | Wide | 64;31 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | SD advantage | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | Error | Backhand | 48;8 | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 0-0 (2) | 577560 | 5520 | In | Middle | Wide | 33;30 | | | | | | | 20/08/2011 | | 01:00 | Player 2 | 0-0 | Player | Returning | Set 1 | Deuce | Player 1 | 00:00 | Repton | In | Forehand | 59;30 | | | | | | | | | | | | | | | | | | | Unforced error | Middle inside | Attacking | Backhand | 57;37 | | | | | | | | | |
| 0-15 (1) | 609040 | 11800 | In | Middle | Body | 61;30 | | | | | | | 20/08/2011 | Winner | 01:00 | Player 2 | 0-15 | Player | Returning | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 57;29 | | | | | | | | | | | | Player 1 | Middle baseline | Forehand | 28;27 | 1 | 1 | Ground stroke | In | Advantage wide | Attacking | Forehand | 75;37 | In | Middle baseline | Neutral | Forehand | 42;27 | | | | |
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
Sum Up Cells to Array
This is how I understand it at the moment. Try it and get back to me in the comments to fix possible issues.
The Code
Option Explicit
Sub sumShotsInRally()
'Set rawData sheet as active
Dim ws As Worksheet
Set ws = Sheets("Input")
'Find first column to sum
Dim sForeCol As Long
sForeCol = ws.Rows(1).Find(What:="Serving player forehand", _
Lookat:=xlWhole).Column
'Add Rally Count Column.
Dim rallyCountCol As Long
rallyCountCol = sForeCol + 1
ws.Columns(rallyCountCol).Insert
ws.Cells(1, rallyCountCol).Value = "Rally Count"
'Find remaining columns to sum
Dim sBackCol As Long
sBackCol = ws.Rows(1).Find(What:="Serving player backhand", _
Lookat:=xlWhole).Column
Dim rForeCol As Long
rForeCol = ws.Rows(1).Find(What:="Returning player forehand", _
Lookat:=xlWhole).Column
Dim rBackCol As Long
rBackCol = ws.Rows(1).Find(What:="Returning player backhand", _
Lookat:=xlWhole).Column
'Define the range to iterate over as the used range of the found column
Dim sFore As Range
Dim sBack As Range
Dim rFore As Range
Dim rBack As Range
Dim RallyCount As Range
'Define column ranges
With ws
Set sFore = .Range(.Cells(2, sForeCol), _
.Cells(.UsedRange.Rows.Count, sForeCol))
Set sBack = .Range(.Cells(2, sBackCol), _
.Cells(.UsedRange.Rows.Count, sBackCol))
Set rFore = .Range(.Cells(2, rForeCol), _
.Cells(.UsedRange.Rows.Count, rForeCol))
Set rBack = .Range(.Cells(2, rBackCol), _
.Cells(.UsedRange.Rows.Count, rBackCol))
Set RallyCount = .Range(.Cells(2, rallyCountCol), _
.Cells(.UsedRange.Rows.Count, rallyCountCol))
End With
'Define Results Array
Dim Results As Variant
'You redimension the results array to the number of entries in your table
ReDim Results(1 To sFore.Rows.Count, 1 To 1)
'You loop over your table and sum the values from count and restocked
For i = 1 To sFore.Rows.Count
Results(i, 1) = sFore(i, 1) + sBack(i, 1) + rFore(i, 1) + rBack(i, 1)
Next i
'You write the array to the range count and delete the values in restocjed
RallyCount.Value = Results
End Sub

VBA - Using criteria list select and clear or select an replace values

Alright, I'm back. This time I'm trying to quickly select all of the values in a range which match values in a separate list, my first iteration will be to clear the contents of voided IDs, my second iteration will be to select those values and then replace them with corresponding new values.
I asked another question about VBA and was pointed in mentioning that I've tried to teach myself and find resources to work through these issues before but people seem to get pissed that I'm asking, if you could at least direct me to somewhere that I can learn about these matters (or even a place I can learn basic logic and have a list of usable functions without having to go through all the "How to make your first Excel VBA for some problem that nobody cares about" I would appreciate it)
Anyway I tried to watch a few videos and then hack together something but it seems pretty clear that the function they were using cannot be adapted for other uses. This is what I have at the moment:
Sub FilterElim()
finalRow = Range("g2").End(xlDown).Row
Range("A1").ClearContents _
Action:= xlClearContents, _
CriteriaRange: Range("Sheet4!B1:B10"), _
Unique:= False
End Sub
So based on some helpful questions I am making an edit to include an example and desired end
Example set:
Desired end result:
I presume I may need to perform a selection of some sort based on the Criteria before the ClearContents but I wasn't finding anything helpful on how to go about that. PLEASE and thank you.
| Contractor ID | Cont Name | Proj 1 | Proj 2 | Proj 3 | | | Old ID | Reconciliation |
|-----------------|-------------------|--------|--------|--------|---|---|--------|----------------|
| C1001 | Boba Fet | P1120 | | | | | P1001 | Void |
| C1003 | Jules Winnfield | P1031 | P1045 | | | | P1002 | P1010 |
| C1002 | Dom Cobb | P1001 | | | | | P1005 | Void |
| C1010 | Patrick Verona | P1020 | P1224 | P1251 | | | P1020 | Void |
| C1007 | Matt Damon | P1008 | P1005 | P1300 | | | P1045 | P1100 |
| C1004 | Ned Plimpton | P1002 | | | | | P1224 | P1300 |
| C1020 | Derek Zoolander | P1020 | P1290 | | | | | |
| C1009 | Charles Marlow | P1002 | P0090 | | | | | |
| C1011 | Robert Jordan | P1119 | | | | | | |
| C1015 | Perrin Aybara | P1200 | P1224 | | | | | |
| C1005 | Fuzzy Dunlop | P1005 | | | | | | |
| C1008 | Thomas A Anderson | P1001 | P1000 | | | | | |
| | | | | | | | | |
What makes you go for a VBA solution ?
Hard to do much without a glance of you data and expected result.
Non VBA option:
=IFERROR(INDEX($G$2:$G$15,MATCH(A32,$F$2:$F$15,0)),B32)
For a VBA option, you can try:
Option Explicit
Sub update_id()
Dim D1 As Object: Set D1 = CreateObject("scripting.dictionary")
Dim R1 As Range: Set R1 = Range("A2:A32")
Dim R2 As Range: Set R2 = Range("E2:E15")
Dim Rtmp As Range
For Each Rtmp In R2
D1(Rtmp.Value) = Rtmp.Offset(0, 1).Value
Next Rtmp
For Each Rtmp In R1
If D1.exists(Rtmp.Value) Then Rtmp.Offset(0, 1) = D1(Rtmp.Value)
Next Rtmp
End Sub
Working on the following set up :
Again, without a better understanding of your data and your issue, its hard to be more precise.

(VBA) Excel - How to transpose variable length columns to rows?

I have an Excel sheet with variable rows but 5 columns.
The final column has comma separated values of varying length.
I have been trying to write a "For Loop" to Transpose this data into Rows while retaining the Data in existing Columns A:D.
Source Data Sample
| User ID | User name | Group ID | Group name | Effective permissions | | | | | |
|---------|-----------|----------|------------|-----------------------|------|------|------|------|------|
| 1 | Adam | 100 | Active | ABCD | RFGE | ERTY | EDFR | | |
| 2 | Bryan | 100 | Bold | IFEU | WASD | WASF | TGRE | YMUN | TYBN |
| 3 | Charles | 100 | Charity | IFLL | ERTY | WSDF | XKLS | | |
| 4 | David | 100 | Danger | IFEU | UNBY | RVBT | ZXCV | XCVB | VBNM |
Output Data Example
| User ID | User name | Group ID | Group name | Effective permissions |
|---------|-----------|----------|------------|-----------------------|
| 1 | Adam | 100 | Active | ABCD |
| 1 | Adam | 100 | Active | RFGE |
| 1 | Adam | 100 | Active | ERTY |
| 1 | Adam | 100 | Active | EDFR |
| 2 | Bryan | 100 | Bold | IFEU |
| 2 | Bryan | 100 | Bold | WASD |
| 2 | Bryan | 100 | Bold | WASF |
| 2 | Bryan | 100 | Bold | TGRE |
| 2 | Bryan | 100 | Bold | YMUN |
| 2 | Bryan | 100 | Bold | TYBN |
| 3 | Charles | 100 | Charity | IFLL |
| 3 | Charles | 100 | Charity | ERTY |
| 3 | Charles | 100 | Charity | WSDF |
| 3 | Charles | 100 | Charity | XKLS |
| 4 | David | 100 | Danger | IFEU |
| 4 | David | 100 | Danger | UNBY |
| 4 | David | 100 | Danger | RVBT |
| 4 | David | 100 | Danger | ZXCV |
| 4 | David | 100 | Danger | XCVB |
| 4 | David | 100 | Danger | VBNM |
Any help you could provide would be greatly appreciated.
**I have completed VBA projects in the past, however I have usually been able to piece together previous examples to achieve my goal...learning along the way.
If someone could show me how to adapt the below code so that each of the values in my first 4 columns are copied down that would be great.
Sub Test()
Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")
For i = 1 To Rng.Cells.Count
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
If rng_values.Cells.Count < 16000 Then
For j = 1 To rng_values.Cells.Count
Rng_output.Value = Rng.Cells(i).Value
Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
Set Rng_output = Rng_output.Offset(1, 0)
Next j
End If
Next i
End Sub
You are very close with that code.
Here is the same code, with a few small changes:
Sub Test()
Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")
For i = 1 To Rng.Cells.Count
'Test to make sure there is less than 16000 columns in this row past D. Yikes, OP!
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
If rng_values.Cells.Count < 16000 Then
'Loop through all of those columns
For j = 1 To rng_values.Cells.Count
'Write out value from Column A:D to our Rng_Output
Rng_Output.Value = rng.cells(i).Offset(0,-3).value 'Column A = Column A
Rng_Output.Offset(0,1).Value = rng.cells(i).Offset(0,-2).value 'Column B = Column B
Rng_Output.Offset(0,2).value = rng.cells(i).OFfset(0,-1).value 'etc..
Rng_Output.Offset(0,3).value = rng.cells(i).value
'Write out value from Column A:D to your `Test2` sheet column E
rng_output.Offset(0,1).Value = rng_values.Cells(j).value
'Increment to the next row
Set Rng_output = Rng_output.Offset(1)
Next j
End If
Next i
End Sub

VBA-Compare sheets and copy values from second sheet

I am trying to compare two workbooks and copy the 5th column to the 5th column first workbook if the first 3 columns match.
This check has to be done throughout the worksheet.
Worksheet 1:
| Heading 1 | Heading2 | Heading 3 | Total | Number1 |
|-----------|----------|-----------|-------|---------|
| ABC | EF | GH | | |
| XYZ | AB | EF | | |
| HIK | IJ | PQ | | |
Worksheet 2:
| Heading 1 | Heading2 | Heading 3 | Total | Number1 |
|-----------|----------|-----------|-------|---------|
| QRS | EF | GH | | 5 |
| XYZ | AB | EF | | 4 |
| DEF | QR | IV | | 16 |
| HIK | IJ | PQ | | 8 |
Desired output:
| Heading 1 | Heading2 | Heading 3 | Total | Number1 |
|-----------|----------|-----------|-------|---------|
| ABC | EF | GH | | |
| XYZ | AB | EF | | 4 |
| HIK | IJ | PQ | | 8 |
I tried to do the following, but it didn't work:
Dim i As Integer
Sheets("Sheet1").Activate
For i = 2 To 100
ActiveSheet.Cells(i,5).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(AND(Table2[#[Heading1]]=Consolidated!RC[-4],Table2[#[Heading2]]=Consolidated!RC[-3],Table2[#[Heading3]]=Consolidated!RC[-2]),Table2[Number1],"" ""),"" "")"
Next i
I am a VBA novice and would be grateful for any help.
You can do this with formulas, no need for code. I'll assume that "Heading 1" is in cell A1 for this: Add a new column between heading 3 and Total. In the first cell add the formula =A2&B2&c2 and copy down. Do the same in the other workbook. Now in Number1 in the first book enter this formula
=IFERROR(OFFSET([OtherWorkbook]SheetName!D2,MATCH(D2,[OtherWorkbook]Sheetname!D2:D5),2),"")
(Using your workbook and sheet names. Now copy down. You can then hide the column we added at the start by setting its width to zero in both books.

Excel 2010: Moving cell right & up from original location (Offsetting it)

Program: Excel 2010
Experience Basic
Issue:
I have a large table of data with some "split cells" (first/last name & currency), this is how it is from the original data (copied & pasted from a webpage, the data is split in 2). I need to make a clean table with all data on 1 row, not 2. I have some sample data below, and then further down I have included how I want it to look like.
The original formatting is a HTML table, pulled from a database (which I do NOT have access to, however I can generate a CSV but that in itself is another question due to how it is setup.)
Assume: Data in (A1); there are more than the listed values & columns, and I will accept either formula OR VBA answers and lastly: Ignore the blank rows, they were inserted to show the difference between tables more clearly.
Original Data:
| Date | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 12/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
Required Data: (notice the first/last are now on the same row as is the currency)
| Date | Transaction ID | Order Reference | Sender | | Sender Email | Status | Payment Amount | | Amount Paid | |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 12/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
Thank you, have a great weekend.
[EDIT]
Note, none of these cells are merged, each cell is an individual, and the "last" & "AUD" need to be moved right & up.
This should work for you:
Public Sub ModData()
Dim colDate As Long
Dim colTrans As Long
Dim colOrder As Long
Dim colSender As Long
Dim colSenderEmail As Long
Dim colStatus As Long
Dim colPmtAmt As Long
Dim colPaid As Long
Dim r As Long
Dim ws As Worksheet
colDate = 1
colTrans = 2
colOrder = 3
colSender = 4
' col 5 reserved for inserted col
colSenderEmail = 6
colStatus = 7
colPmtAmt = 8
' col 9 reserved for inserted col
colPaid = 10
Set ws = ActiveSheet
Application.ScreenUpdating = False
' Add extra columns needed.
ws.Columns(colSender + 1).Insert Shift:=xlToRight
ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight
' Move data to same row.
For r = 2 To 12 Step 2
ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
Next r
' Delete unnecessary rows.
r = 3
While ws.Cells(r - 1, 1).Value <> ""
ws.Cells(r, 1).EntireRow.Delete
r = r + 1
Wend
Application.ScreenUpdating = True
End Sub

Resources