Solved: Update Value from one column to another column under 1 row

[winxmun]

Hi there, i have a set of data that consists of Name, Product Type (2 product type only) & some numbers (in "Original" worksheet). Each time i will manually update the different Product Type under same Name into 1 row (in "New" worksheet). I take about 2 hrs + to finish the manual updating (about 100+ rows). Anyone have better way to do this? :dunno

Regards,
winxmun

[Bob Phillips]

I think we eed more detaiil on the logic for extracting the data from Original. For instance, I get why B1:B13 are what they are, but why are C11:c13 on New?

[winxmun]

Hi xld, the "Original" worksheet is the original data with fields called "Name", Product Type", "0", "1" until "Total O/s". The "New" worksheet is created by me with 2 levels of field name, ie row 1 is either HL or HDB which is transfer from Product Type' value. I will do the followings each time recd the file with "Original" worksheet only.
1. Create a worksheet, ie "New".
2. Insert new coloumn beside field name "0" until "102" at "New" worksheet.
3. Insert new row to create field name HL & HDB at "New" worksheet.
4. Combined same Name into 1 row & update the value under field name "0" to "102" according to Product Type at "New" worksheet.

Hope this is clear for your assistance. tks!

[tstav]

Hi winxmun,
remember to have the titles already placed in the 'New' Sheet before you run this.
Sub RearrangeTableValues()
Dim lngRow As Long, endRow As Long, outputRow As Long, addCol As Long
Dim intI As Integer, intK As Integer, index As Integer
Dim varArray(1 To 2, 1 To 8) As Integer
outputRow = 2 '<-- Output data will start after this row

With Worksheets("New")
.Range(.Range("A3"), .cells.SpecialCells(xlCellTypeLastCell)).ClearContents
End With

With Worksheets("Original")
endRow = .Range("A" & .Rows.count).End(xlUp).Row 'end row of 'Original' data

'For each row in 'Original' data
For lngRow = 2 To endRow
'Check if it is HL or HDB type
Select Case UCase(.Range("A" & lngRow).Offset(0, 1).Value)
Case Is = "HL"
addCol = 1
Case Is = "HDB"
addCol = 2
End Select
index = 0

'Store this Name's values and title numbers
For intI = 1 To 8
If IsNumeric(.cells(lngRow, 2 + intI).Value) And .cells(lngRow, 2 + intI).Value <> "" Then
index = index + 1
varArray(1, index) = .cells(lngRow, 2 + intI).Value 'cell value
varArray(2, index) = intI - 1 'title number
End If
Next

'Write to 'New' Sheet
With Worksheets("New")
'If new 'Name', increment the output row and write the Name
If .Range("A" & .Rows.count).End(xlUp).Value <> Worksheets("Original").Range("A" & lngRow).Value Then
outputRow = outputRow + 1
'Write the Name
.Range("A" & outputRow).Value = Worksheets("Original").Range("A" & lngRow).Value
End If
'Write the Name's values
For intK = 1 To index
.cells(outputRow, addCol + 2 * (varArray(2, intK)) + 1).Value = varArray(1, intK)
Next
End With
Next

'Add the totals
With Worksheets("New")
outputRow = outputRow + 1
.Range("A" & outputRow).Value = "Total:"
For intI = 2 To 17
.cells(outputRow, intI).Value = WorksheetFunction.Sum(.Range(.cells(3, intI), .cells(outputRow - 1, intI)))
Next
End With
End With
End Sub


Edit: Minor changes mostly to comments

[winxmun]

Hi tstav, your code is very awesome! :thumb It really save a lot of my work....tks a lot.:mbounce: