To move the cell values in a group from right to left if any group of cells are blank using VBScript without using any Looping technique?

Question

Is there any faster process to move the cell values in a group from right to left if any group of cells are blank using VBScript without using any Looping technique? (Packing the data of each row , to the left)

Input Table:*

Project#    T1Name     T1StartDate    T1FinishDate   T2Name     T2StartDate    T2FinishDate  T3Name     T3StartDate    T3FinishDate

   11         S1        12/7/2012      19/7/2012                                               S2        12/7/2012      19/7/2012
   12                                                                                          S2        12/6/2012 
   13                                                  S4        11/05/12                      S6                       12/5/10

Output Table:

Project#    T1Name     T1StartDate    T1FinishDate   T2Name     T2StartDate    T2FinishDate  T3Name     T3StartDate    T3FinishDate

   11         S1        12/7/2012      19/7/2012       S2        12/7/2012      19/7/2012
   12         S2        12/6/2012  
   13         S4        11/05/12                       S6                       12/05/10

Updated MY Output Table Please check,firstly it was got misplaced!

Update1

Project#    T1Name     T1StartDate    T1FinishDate   T2Name     T2StartDate    T2FinishDate  T3Name     T3StartDate    T3FinishDate

  10         S1                         11/5/2011                                              S2                        5/5/2011


  11                                                   S1         11/5/2011     5/4/2011        S1         11/5/2011     5/4/2011

Update2

Project#    T1Name     T1StartDate    T1FinishDate   T2Name     T2StartDate    T2FinishDate  T3Name     T3StartDate    T3FinishDate 

  11                     11/5/2011                      S1       11/5/2011        5/4/2011      S2         11/5/2011    5/4/2011

Add this entry to the table it is not shifted properly. Can you check please?

Updated Code:

 Option Explicit

 Dim objExcel1,objWorkbook
 Dim strPathExcel1
 Dim objSheet1,IntRow1
 Dim Task,Totltask
 Dim DataArray(14),index,Counter

 Set objExcel1 = CreateObject("Excel.Application")
 strPathExcel1 = "D:\VA\TestVBSScripts\Test.xlsx"

 Set objWorkbook=objExcel1.Workbooks.open(strPathExcel1)
 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

 IntRow1=2
Do While objSheet1.Cells(IntRow1,1).Value <> ""
 Totltask=2
 index=0
Do Until Totltask> 10

 'MsgBox("Hi")

  If objSheet1.Cells(IntRow1,Totltask).Value <> "" Or   objSheet1.Cells(IntRow1,Totltask+1).Value <> "" Or objSheet1.Cells(IntRow1,Totltask+2).Value <> "" Then

  DataArray(index)=objSheet1.Cells(IntRow1,Totltask).Value
  DataArray(index+1)=objSheet1.Cells(IntRow1,Totltask+1).Value
  DataArray(index+2)=objSheet1.Cells(IntRow1,Totltask+2).Value

  index=index+3

   End If

  Totltask=Totltask+3
  Loop

  Totltask=2
 Counter=index-1
 index=0
 'MsgBox(Counter)
 Do While index < Counter 
     'MsgBox("Hi")
objSheet1.Cells(IntRow1,Totltask).Value=DataArray(index)
objSheet1.Cells(IntRow1,Totltask+1).Value=DataArray(index+1)
objSheet1.Cells(IntRow1,Totltask+2).Value=DataArray(index+2)

Totltask=Totltask+3
index=index+3

  Loop

  Erase DataArray

 Do Until Totltask >10

    objSheet1.Cells(IntRow1,Totltask).Value=""
 Totltask=Totltask+1

 Loop

IntRow1=IntRow1+1
 Loop

  '=======================
  objExcel1.ActiveWorkbook.SaveAs strPathExcel1
  objExcel1.Workbooks.close
  objExcel1.Application.Quit
 '======================

***Can any body suggest how should i make it more faster,If possible? This code is correct,producing output as desired.But too slow.

Can any body help me here? Its too much confusing for me to frame as I have shown above. Please help me here! — Arup Rakshit, Dec 12 '12 at 15:13
I just updated my case description,So that you can be more sure about what i am looking for. :-) — Arup Rakshit, Dec 13 '12 at 06:45
@Larry Can you say all the constant number of such xlUp,xlDown etc for my future reference? — Arup Rakshit, Dec 13 '12 at 08:52
Larry please check the updated table data with script... it is shifting properly — Arup Rakshit, Dec 13 '12 at 10:10
Larry,Please take the updated table as your input table,you can see it is not producing the desired output. Columns are not getting shifted in as 3 data full chunk. — Arup Rakshit, Dec 13 '12 at 10:47
ha ha... yes he tried lots. but still there was bug,finally i did it. Bon can u improve my one by introducing any good engineering? — Arup Rakshit, Dec 13 '12 at 19:53
@bonCodigo as I am not familiar with VBS, I take this as a practice. OP, glad that you fixed my bug, let's try to assign back the values by ROW, if still not fast enough, assign back the value by the whole sheet — Larry, Dec 14 '12 at 00:22
Hi, I know why my code is NOT working properly, is because I assume for each unit, the name , e.g. T1Name must exist — Larry, Dec 14 '12 at 02:11
Can you give me a small tips,by saying what change i need to do,if there is 4 or 5 blocks instead of 3.Because in real time data i do have 4 columns to move from left to right like 3 blocks here.whole the logic is same.only the number of columns is 4 instead of 3. — Arup Rakshit, Dec 14 '12 at 03:44
Hi OP, does my edited version works and faster? To change it from 3 to 4, similar to your own version of coding, first change the "3" into "4" in my code, then for all the case N, N+1, N+2, add 1 more case for N+3 — Larry, Dec 14 '12 at 05:37
please confirm if it's correct first, then I can maybe include a version of code works for 4 columns, e.t.c — Larry, Dec 14 '12 at 05:38
What does"OP" mean? :-) Yes..it is perfect!totally bug fixed.So now can you say for 4 columns chunk where we need to change? — Arup Rakshit, Dec 14 '12 at 05:51
you means every time if i change the value of "ColumnInGroup" to 2,3,4.... depending on the chunk size, it will work for me right? — Arup Rakshit, Dec 14 '12 at 07:10
ys, if a group is 3, then set columnInGroup = 3, if a group is 4 , then set columnInGroup = 4, if you found bug in any case, please update the post — Larry, Dec 14 '12 at 07:11
Thanks i am closing my post with some vote for you.Really helpful to work with you. If you have time can you please look into the below post? http://stackoverflow.com/questions/13852781/set-minus-operation-using-vbscript-on-excel-sheets#comment19076403_13852781 — Arup Rakshit, Dec 14 '12 at 07:15

Larry · Accepted Answer · 2012-12-14T06:36:01.893

1

EDIT:make the number of column in a group from 3 to N (ColumnInGroup)

EDIT: Fixed some bugs, and allow "NAME" field to be empty, a "T" type is treated as exist if either Name, start date, end date exist, improved performance by assigning back in ROW unit instead of cell unit

EDIT:Fixed a bug

EDIT: I get the value of these constant in VBA, you open an excel, Alt + F11 to open VB Editor, Crtl + G open an immediate window, type ?xlUp , it will show the value of xlUp below

The Code Below is in VBS, works on the sheet you currently display and the performance should be okay... Change the Workbook full path, worksheet name to use

Option Explicit

Dim xlApp
Dim xlBook
dim xlSheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.EnableEvents = False
xlApp.ScreenUpdating = False
'xlApp.Calculation = -4135 'xlCalculationManual

set xlBook = xlApp.Workbooks.Open("C:\Users\wangCL\Desktop\data.xlsx")
set xlSheet = xlBook.Worksheets("data (4)")






'CONTENT HERE

Dim count 
Dim dataArray 
Dim height 
Dim width 
Dim rWidth 
Dim packArray 
Dim i 
Dim j
dim rowArray
dim ColumnInGroup
dim k 
dim b 
With xlSheet 
    .activate
    ColumnInGroup= 4
    height = .Cells(.Rows.count, 1).End(-4162).Row
    ' assume 1st line is header
    ' start from 2nd line
    If height > 1 Then
        For i = 2 To height

            width = .Cells(i, .Columns.count).End(-4159).Column
            'round width
            if (width -1 )mod columnInGroup <> 0 then  
                width = (((width -1)\columnInGroup )+1)* columnInGroup + 1
            end if
            if width > 1 then 
                'finding the last unit originally packed 
                redim rowArray(0,width-1)
                rowArray = .range(.cells(i,1), .cells(i,width)).value
                'default value
                rWidth = width
                for j = 2 to width  step ColumnInGroup
                    if j+ColumnInGroup -1 <= width then 
                        b = false
                        for k = 0 to ColumnInGroup - 1
                            if rowArray(1,j+k) <> "" then 
                                b = true 
                                exit for 
                            end if
                        next 
                        if not b then 
                            rWidth = j - 1
                            exit for
                        end if
                    else
                        rWidth = width
                    end if
                next
                'rWidth = .Cells(i, 1).End(-4161).Column

                'If .Cells(i, rWidth - 1).Value = "" Then
                '    rWidth = 1
                'End If
                ''check for each new "T" - 1
                'If rWidth Mod 3 = 0 Then
                '    rWidth = rWidth  + 1
                'ElseIf rWidth Mod 3 = 1 Then
                '    rWidth = rWidth 
                'ElseIf rWidth Mod 3 = 2 Then
                '    rWidth = rWidth  + 2
                'End If
                ' if is not packed
                If width > rWidth Then
                    ReDim dataArray(1 ,(width - rWidth))
                    dataArray = .Range(.Cells(i, rWidth + 1), .Cells(i, width)).Value

                    count = 0

                    For j = LBound(dataArray, 2) To UBound(dataArray, 2) Step ColumnInGroup
                        if j+ColumnInGroup - 1<= ubound(dataArray,2) then 
                            b = false
                            for k = 0 to ColumnInGroup - 1
                                if dataArray(1,j+k) <> "" then 
                                    b = true 
                                    exit for 
                                end if
                            next 
                            if  b then 
                                count = count + 1
                            end if
                        else
                            exit for
                        end if
                    Next

                    ReDim packArray(0, count * columnInGroup - 1)
                    count = 0
                    For j = LBound(dataArray, 2) To UBound(dataArray, 2) Step columnInGroup
                        ' we found a "T" Unit
                        if j+columnInGroup -1<= ubound(dataArray,2) then 
                            b = false
                            for k = 0 to ColumnInGroup - 1
                                if dataArray(1,j+k) <> "" then 
                                    b = true 
                                    exit for 
                                end if
                            next 
                            if  b then 
                                count = count + 1
                                for k = 0 to columnInGroup - 1
                                    If j + k <= UBound(dataArray, 2) Then
                                        packArray(0, (count - 1) * columnInGroup  + k ) = dataArray(1, j + k)
                                    end if
                                next 
                            end if

                        else
                            exit for
                        end if

                    Next

                    'clear original data
                    .Range(.Cells(i, rWidth + 1), .Cells(i, width)).ClearContents

                    'for j = 1 to ubound(packArray,2)
                '       .cells(i,rWidth+j).value = packArray(1,j)
                '   next 
                    .Range(.Cells(i, rWidth + 1), .Cells(i, rWidth + count * columnInGroup)).Value = packArray

                End If
            end if
        Next

    End If

End With

xlBook.save
xlApp.Quit
set xlSheet = nothing
set xlBook = nothing
set xlApp = nothing

msgbox "Done"

edited Dec 14 '12 at 06:36

answered Dec 13 '12 at 06:05

Larry

2,764
2
25
36

Hi Larry, Thanks for your help. But i have no choice to implemet the logic in VBA.So i have to implement it in VBScript. And also i am not educated in VBA. Can you help me using VBscript the same? – Arup Rakshit Dec 13 '12 at 06:36
Hi, is the data stored in excel format? Can I use Excel.Application in VBScript? – Larry Dec 13 '12 at 06:38
Yes.. You can use that.Because when my 5th script will be working to meet such requirement;then its required data will be already pulled to the required sheet by 1st script. I just updated my Case description by adding one more Rows to the tables,so that the requirement can be visible to you clearly. Thanks for your help :-) – Arup Rakshit Dec 13 '12 at 06:48
Hi, please join the chat room for further explanation http://chat.stackoverflow.com/rooms/21049/http-stackoverflow-com-questions-13823912-to-move-the-cell-values-in-a-group-fr – Larry Dec 13 '12 at 06:53
Hum,,If i could do so it would be better for me.But my firewall blocking to open that chat room. So here I can help you if you need any help from me. – Arup Rakshit Dec 13 '12 at 07:04
Hi, I would like to know more about the format, so it is always in the format "T1Name T1StartDate T1FinishDate" and what's the file extension? and why can't use Excel (VBA) while excel object in vbs can be used? – Larry Dec 13 '12 at 07:07
Yes the format will be always same,the way i have shown you. May be there 400 columns,but the format is exactly the same,what i have shown in my case description. I was told to implement it in VBScript.Thus VBA can not be used. – Arup Rakshit Dec 13 '12 at 07:11
Hi, and what is the file extension ? .txt, .xls? because you describe it as a "Table" what's the delimiter? – Larry Dec 13 '12 at 07:15
Ok, so you want it to shift by "T" as a unit , and is there a blank line between Project# and "11"? – Larry Dec 13 '12 at 07:27
No..11 is the immediate next row of the Project# – Arup Rakshit Dec 13 '12 at 07:30
1 more question on your example, S6 12/5/10. 12/5/10 was the end date, your output change it to the start date, is that correct? so you want to shift by "T" as a unit and pack the dates? – Larry Dec 13 '12 at 07:40
Let me check the same...it may be my error when i was formatting my output table data – Arup Rakshit Dec 13 '12 at 07:52
Did you check my updated output table? If any confusion have please let me know – Arup Rakshit Dec 13 '12 at 08:08
I am waiting for your code,,,which can give me a right direction. :-) – Arup Rakshit Dec 13 '12 at 08:09
Yeah, I came up with a VBA solution, now converting it into a VBS solution – Larry Dec 13 '12 at 08:11
Thank you very much Dear friend, your such implementation would help me to bring down my 150 lines of code from a script of 1756 lines of code. :-) – Arup Rakshit Dec 13 '12 at 08:20
your Excel file is .xlm, but i will use it as.xlsx. Hope there should not be any issue. – Arup Rakshit Dec 13 '12 at 08:49
Surely no problem for this issue.Wait I am testing it <-- TESTED, it's the same – Larry Dec 13 '12 at 08:49
Yeah, VBScript is NOT as flexible as VBA. As a good practice, accept my answer if it's working for you. – Larry Dec 13 '12 at 09:01
**VBScript is NOT as flexible as VBA** - Why do you say that? I would suggest that the only major differences between VBA and VBScript is that VBA has types and VBScript has only Variants, and that VBScript supports running code outside of modules. If you mean that VBA has a built-in IDE, you can use MSE or the VS Shell - see [here](http://stackoverflow.com/a/13802548/111794). – Zev Spitz Dec 13 '12 at 09:15
@ZevSpitz Thanks for the good reading. What I meant is I always have a bad time debugging VBScript program. Also with types and built-in IDE. It's easier to code. I will try the MSE you mentioned. – Larry Dec 13 '12 at 09:22
What editor do you use? I use Notepad++ for synatx highlighting, and I've added an entry to the Run menu that opens the current script in a debugger (with the command-line in the above-mentioned link). Almost the same effect as the VBA IDE. – Zev Spitz Dec 13 '12 at 09:26
@ZevSpitz Notepad, I don't have the permission to install even Notepad++ :( And may I ask can the Microsoft Script Editor execute VBScript line by line and have something similiar to VBA Watch window? – Larry Dec 13 '12 at 09:28
Can you run it without installing? There's a non-install edition on the [downloads](http://notepad-plus-plus.org/download/v6.2.2.html) page. – Zev Spitz Dec 13 '12 at 09:31
@ZevSpitz Thanks for your help, I can't download or install anything – Larry Dec 13 '12 at 09:32
let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/21063/discussion-between-zev-spitz-and-larry) – Zev Spitz Dec 13 '12 at 09:32
Hi, there are 3 tables currently in your question. So you run the script with 1st table as input, and which one is the script output? is it working properly? And how is it not working properly now? thanks – Larry Dec 13 '12 at 10:15
updated is the input table,,i ran the script on the that table,, but not the output is coming as desired. 2nd table is the output table.please check :-) – Arup Rakshit Dec 13 '12 at 10:19
Using Input Table, I get the Output Table , Using the 3rd Table, one field is missing – Larry Dec 13 '12 at 10:38
Thus telling to check with the updated table as an input table.In every possible scenario the column should shift in chunk wise.If its left 3 cells are blank completely,otherwise not. – Arup Rakshit Dec 13 '12 at 10:49
There's a bug in my script, fixing it – Larry Dec 13 '12 at 10:50
Okay,Thanks please... My all data wrongly shifted.I was also running my other scripts to get them positioned correctly. Waiting for your one to test again – Arup Rakshit Dec 13 '12 at 10:52
But one area still we need to take care of where bug still remains,I just updated the output table again.Please try this one it is not producing good expected data. – Arup Rakshit Dec 13 '12 at 11:13
in the UPDATE2 table,if you take it as an input data,no data should shift,output table should be look like as input table.But it is not happening. @Larry – Arup Rakshit Dec 13 '12 at 11:19

score 1 · Answer 2 · answered Dec 18 '12 at 09:37

I suggest using the Delete method of Excel.Range to delete the empty cells, and passing a parameter to shift the remaining cells to the left:

Option Explicit

Dim xlApp, xlBook, xlSheet
Dim rowCount, columnCount, i, j, currentColumnCount
Dim rng, cell, hasValue
Const xlShiftToLeft = -4159

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\path\to\excel\file.xlsx")
Set xlSheet = xlBook.Worksheets("WorksheetName")
rowCount = xlSheet.UsedRange.Rows.Count
columnCount = xlSheet.UsedRange.Columns.Count - 3

For i = 2 To rowCount
    currentColumnCount = columnCount
    j = 2

    Do While j <= currentColumnCount
        Set rng = xlSheet.Range(xlSheet.Cells(i,j), xlSheet.Cells(i,j+2))
        hasValue = False
        For Each cell In rng.Cells
            If cell.Value <> "" Then
                hasValue = True
                Exit For
            End If
        Next

        If hasValue Then
            j = j + 3
        Else
            rng.Delete xlShiftToLeft
            currentColumnCount = currentColumnCount - 3
        End If
    Loop    
Next

xlBook.Save
xlApp.Quit

One confusion,that I am having is i added one line of code to your one to meet my other requirement is `objExcel1.sheets("Temp").Add`. But getting an error saying `Subscript out of range` Can you say why so? — Arup Rakshit, Dec 19 '12 at 15:59
Are you trying to add a new worksheet named `Temp` to the workbook? You can't refer to the worksheet by name if it doesn't yet exist in the workbook. You need to add the worksheet to the workbook (not the `Application` object which `objExcel1` is, but to the `Workbook` object - `objWorkbook`) via the `Worksheets` collection - `Dim tempSheet: Set tempSheet = objWorkbook.Worksheets.Add(): tempSheet.Name = "Temp"` — Zev Spitz, Dec 20 '12 at 00:16
You should probably give a more descriptive name to `objExcel`, as it refers to an `Excel.Application`, but sounds like it might refer to any Excel object. My own preference is to use `xlApp`. — Zev Spitz, Dec 20 '12 at 00:17

To move the cell values in a group from right to left if any group of cells are blank using VBScript without using any Looping technique?

2 Answers2

Linked