How to merge cells having different ranges using VBA?

[AmruthSagar]

Hi All,

I am working on this VBA code which will take input from a notepad named "Analysis Fields" and add it to the excel worksheet as shown in "Final Output" sheet (Reference docs attached).

However, the problem is i can only come up to the output as shown in "Sheet1". I am unable to merge cells as required. There may be different level of analysis fields (as shown in .txt file), so the merging will be different for each of the project.

Could you please provide me with some hints so that i can generate the final output as shown.

Looking forward to your responses.

Thanks & regards,
Amruth

 

[Marc L]

Hi !

Differents ways, depends on real text files ! Any couple of real text files ?
No needs hidden worksheet …​

 

[AmruthSagar]

Hi !

Differents ways, depends on real text files ! Any couple of real text files ?
No needs hidden worksheet …​

Hi Marc,

What i understand is you are asking for couple of more examples to check and get this done. I am attaching a test file with few more examples.

As you can observe in example 3 the level of fields will also differ. In this case it is upto Level 5.

If you require any other information please let me know.

Thanks,
Amruth

 

[Marc L]

There is no data in the text file, just headers ?‼


​

 

[AmruthSagar]

There is no data in the text file, just headers ?‼
​

Yes Marc, I just want to merge cells as shown in "Final Output" worksheet.

For Example: In "Sheet1", if you see Field1 under Header1 is in cell "A2", however, in "Final Output" sheet, the Field1 under Header1 is merged from cells A2:A4.

Similarly, in "Sheet1" -- Header3 --> Field2--> Subfield2--> is in cell "J3"
however, in "Final Output" -- Header3 --> Field2--> Subfield2--> is combination of cells "J3:J4".

Hope i am clear and you are able to get it what i am trying to say.

Just to give you the background why i am trying to do this:

We need to analyze multiple journals/articles and so in order to do this we will have these analysis fields under which we place the analyzed data (manually analyzed) for each of the articles. In some cases we have as many as more than 100 headers with multiple subfields and so to arrange them in excel and merge cells as required takes a hell a lot of time.

If you require any information, i shall try to provide you ASAP.

Thanks & regards,
Amruth

 

[Marc L]

Last header is always alone ? Like in your samples …


​

 

[AmruthSagar]

Not necessarily. It depends on the requirement.

 

[Marc L]

So I can just give some hints …

First, see in VBA help GetOpenFilename method to choose the file …

If after header there is a blank cell, via End property (.End(xlToRight))
- it's like you hit keyboard CTRL + Right Arrow - you find next header
so you can merge or better center across selection previous header …

Should be easier if source text file wasn't created by Dumb or Dumber !
​

 

[AmruthSagar]

Sure Marc. I shall try and get back to you if i face any issues...

 

[Marc L]

See also CurrentRegion property from A1 cell to get the headers block
and you can get total of columns & rows (ex: .Rows.Count) …

​

 

[p45cal]

Check this one very carefully, I have done a little checking and it seems OK:

Sub blah()
Dim strMyLine As String
Dim myFile As String
Dim colCount As Integer
Dim i As Long
Dim fPath As String

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("rawData").Visible = xlSheetVisible
Sheets("rawData").Cells.Delete
Sheets("Sheet1").Cells.Delete
Sheets("rawData").Select
Range("A1").Select
FR = ActiveCell.Row
myFile = FreeFile

fPath = Application.InputBox("Please input notepad file path containing analysis fields", "Analysis Fields Source")
If Len(fPath) = 0 Then  'Checking if Length of file path is 0 characters
  MsgBox "Please enter a valid file path", vbCritical
End If
maxTabCount = 0
Open fPath For Input As #myFile
Do While Not EOF(myFile)
  Line Input #myFile, strMyLine
  tabcount = 0
  Do While Mid(strMyLine, tabcount + 1, 1) = vbTab
    tabcount = tabcount + 1
  Loop
  If tabcount > maxTabCount Then maxTabCount = tabcount
  If ActiveCell.Offset(0, tabcount) <> "" Or tabcount < lastTabCount Then ActiveCell.Offset(1, 0).Activate
  ActiveCell.Offset(0, tabcount) = Application.WorksheetFunction.Clean(strMyLine)
  lastTabCount = tabcount
Loop
Close #myFile
LR = ActiveCell.Row
LC = maxTabCount + 1
For Each colm In Range("A1").Resize(LR, LC - 1).Columns
  For Each cll In colm.SpecialCells(xlCellTypeConstants, 23).Cells
    x = 1
    Do Until Len(cll.Offset(, x)) > 0 Or x + cll.Column > LC
      x = x + 1
    Loop
    y = 1
    Do Until Len(cll.Offset(y)) > 0 Or y + cll.Row > LR Or cll.Offset(y).mergeCells
      y = y + 1
    Loop
    cll.Resize(y, x).mergeCells = True
  Next cll
Next colm

ActiveSheet.UsedRange.Copy
ActiveWorkbook.Sheets("Sheet1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
ActiveSheet.UsedRange.EntireColumn.AutoFit
Range("A1").Select

Application.CutCopyMode = False
ActiveWorkbook.Sheets("rawData").Visible = xlSheetHidden
Application.ScreenUpdating = True
End Sub

I haven't paid any attention to error checking the filename.

 

[AmruthSagar]

@p45cal - I really really appreciate your help. This code works fine for me. Thanks a ton.

I have just Run the code and checked it. Now, i shall go through each and every line and understand what exactly the code is doing. I am new to VBA and so if i have any doubts in understanding the code, hope you don't mind if i get back to you.

Thanks.