I have sheet "Raw data" taken from Microsoft word table and pasted in excel. I have another sheet "Required format" where output is appended each time when I click the macro button. But every time the raw data table will be deleted and furnished with new data and it need to be appended into required format sheet by clicking macro button. Test file attached. I am in need of this esteem group to resolve my problem.
word table data into Excel data list
-
gentle_20052006 -
October 5, 2016 at 12:37 PM -
Thread is marked as Resolved.
-
-
-
Re: word table data into Excel data list
Any hope for resolution by this helping group?
-
Re: word table data into Excel data list
Where is the code that gets it from the RAW state to the DESIRED state?
There is not code on the button you have on the page.
-
Re: word table data into Excel data list
I am looking for code behind the button only. your help may indeed be fruitful if you give me code. Thank you
-
Re: word table data into Excel data list
It's crude but it works.
Code
Display MoreOption Explicit Sub ReformatData() ' Local Variables Dim rngSrc As Range Dim rngDest As Range Dim wksSrc As Worksheet Dim wksDest As Worksheet Set wksSrc = Worksheets("Raw data") Set wksDest = Worksheets("Required Format") ' Transpose Data For Each rngSrc In wksSrc.Range("A3", wksSrc.Range("A" & wksSrc.Cells.Rows.Count).End(xlUp)) Set rngDest = wksDest.Range("A" & wksDest.Cells.Rows.Count).End(xlUp).Offset(1, 0) With rngDest If rngSrc.Range("A1") = 1 Then .Range("A1") = rngSrc.Range("A1") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 2 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 3 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 4 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 5 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B2") .Range("D1") = rngSrc.Range("B3") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 6 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B2") .Range("D1") = rngSrc.Range("B3") .Range("E1") = rngSrc.Range("B4") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 7 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B2") .Range("D1") = rngSrc.Range("B3") .Range("E1") = rngSrc.Range("B4") .Range("F1") = rngSrc.Range("B5") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 8 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B1") .Range("D1") = rngSrc.Range("B2") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 9 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B2") .Range("G1") = rngSrc.Range("D1") ElseIf rngSrc.Range("A1") = 10 Then .Range("A1") = rngSrc.Range("A1") .Range("B1") = rngSrc.Range("B1") .Range("C1") = rngSrc.Range("B2") .Range("D1") = rngSrc.Range("B3") .Range("G1") = rngSrc.Range("D1") Else End If End With Next rngSrc End Sub
-
-
Re: word table data into Excel data list
Thank you. The list is sample but in actual data there are lot of rows and sub-characteristics and methods. The above code is restricted to only 4 sub-char and 4 methods and 10 rows of data. can I get still refined code to make work in real large set of data?
-
Re: word table data into Excel data list
any hope ? any improvement in code?
-
Re: word table data into Excel data list
I'm on it.
One question though: What is the maximum number of Sub-Characteristics and Methods? -
Re: word table data into Excel data list
Thanks enijhuis, The sub-characteristics max 30 and methods max 5 .
-
Re: word table data into Excel data list
Hi Gentle,
Done.
I renamed codename Sheet1 to ShRawData and Sheet2 to ShTarget.File:
[ATTACH=CONFIG]70380[/ATTACH]Code:
Code
Display MoreOption Explicit 'Require variable declaration 'Constants; 'Column numbers (source and target sheet): Private Const COL_SRC_SNRS = 1 'Sheet Raw Data: S.No Private Const COL_TRG_SNRS = 1 'Sheet Target: S.No Private Const COL_TRG_M_CHAR = 2 'Sheet Target: MAIN CHARACTERISTICS Private Const COL_TRG_S_CHAR1 = 3 'Sheet Target: Column Sub-Characteristics-1 Private Const COL_TRG_METH1 = 33 'Sheet Target: Column Method 1 'Display the raw data in the correct format Public Sub ProcessData() Dim rSerialNrs As Range Dim l As Long On Error GoTo ErrH 'Ask confirmation If MsgBox("Are you sure?", vbQuestion + vbYesNo) = vbNo Then Exit Sub 'Initialisations Application.ScreenUpdating = False 'Determine list containing the serial numbers 'Assumption: First serial no. in tab raw data starts in A3. With ShRawData Set rSerialNrs = .Range(.Range("a3"), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 1)) End With 'Loop through the serial numbers For l = 1 To rSerialNrs.Cells.Count 'Filled serial no? If Not IsEmpty(rSerialNrs.Cells(l)) Then 'Process a single serial number Call ProcessSerialNumber(rSerialNrs.Cells(l), rSerialNrs.SpecialCells(xlCellTypeLastCell)) End If Next MsgBox "Done", vbInformation CleanUp: Application.ScreenUpdating = True Exit Sub ErrH: MsgBox "Next error occurred:" & vbCr & Err.Description & " (" & Err.Number & ")", vbExclamation Resume CleanUp End Sub 'Process a single serial number Private Sub ProcessSerialNumber(ByVal rSerialNr As Range, rLastCell As Range) Dim rSerialNrList As Range Dim rCellRawData As Range Dim rCell As Range Dim lRowTarget As Long Dim i As Integer Dim j As Integer 'Initialisations 'Determine last row. I renamed Sheet2 to ShTarget which is more descriptive lRowTarget = ShTarget.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1 'Print target serial nr ShTarget.Cells(lRowTarget, COL_TRG_SNRS) = rSerialNr 'Print target Main Characteristics ShTarget.Cells(lRowTarget, COL_TRG_M_CHAR) = rSerialNr.Offset(ColumnOffset:=1) 'Determine range regarding this serial nr Set rSerialNrList = rSerialNr Do i = i + 1 Set rSerialNrList = rSerialNrList.Resize(Rowsize:=i) 'Does not work properly because of merged cells: Set rSerialNr = rSerialNr.Offset(RowOffset:=1) :( Alternative: Set rSerialNr = ShRawData.Cells(rSerialNr.Row + 1, COL_SRC_SNRS) Loop While IsEmpty(rSerialNr) And rSerialNr.Row <= rLastCell.Row 'Print Sub-Characteristics For i = 2 To rSerialNrList.Cells.Count Set rCellRawData = rSerialNrList.Cells(i).Offset(ColumnOffset:=1) If Not IsEmpty(rCellRawData) Then ShTarget.Cells(lRowTarget, COL_TRG_S_CHAR1 + j) = rCellRawData j = j + 1 End If Next 'Print methods j = 0 For i = 1 To rSerialNrList.Cells.Count Set rCellRawData = rSerialNrList.Cells(i).Offset(ColumnOffset:=3) If Not IsEmpty(rCellRawData) Then ShTarget.Cells(lRowTarget, COL_TRG_METH1 + j) = rCellRawData j = j + 1 End If Next End Sub
Cheers.
-
-
Re: word table data into Excel data list
Thank you .Great work done. It does the job in your file provided but when I copy the code to my actual file and try to run it, gives the error "variable not defined".How can I copy this code to my working file and run it without error. But copying my data and pasting it in your file provided would take long time. Thank you
-
Re: word table data into Excel data list
It's good practice to always state which line of code is giving the error, not just that you are getting an error.
My guess would be that is has to do with the sheet names, but you need to verify this.
-
Re: word table data into Excel data list
Hi Gentle,
Bruce is right. As I stated in my previous post I renamed codename Sheet1 to ShRawData and Sheet2 to ShTarget.
I assumed this would trigger you to rename the sheets on your side, if needed.Do the following to rename the codenames of the sheets:
- Open the VB editor: Alt+F11
- Make the Project Explorer visible: Ctrl+R
- Make Properties Window visible: F4
- Select Sheet1 in the Project Explorer by clicking on it
- Rename 'Sheet1' to 'ShRawData' and press Enter
- Repeat steps above to rename 'Sheet2' to 'ShTarget'
Make sure the code compiles: from the VBE-menu select 'Debug' ; 'Compile VBAProject'
See picture below:
[ATTACH=CONFIG]70387[/ATTACH]I must say I'm a bit worried how you will be able to maintain the code if you're unable to address these warnings.
Cheers, -
Re: word table data into Excel data list
I also changed the way the macro is called: Commandbutton1_Click() was replaced by ProcessData().
Replace your button in sheet Raw Data by a shape and assign macro ProcessData to it. -
Re: word table data into Excel data list
Hi Gentle,
And? Where you able to make it work?
-
-
Re: word table data into Excel data list
HI Enijhuis,
I am sorry I was away for some time. Great work !!!! cool !! mission accomplished.
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!