reposition values in columns in vba

I have written a routine to remove deleted client codes from multiple columns in a table. Each mvriscode can have more than one client code so once some have been deleted I would like to reposition the existing so that the columns dont have nulls in between columns with values.

so

col1 col2 col3 col4 col5 col6 col7
   1             4      7             8     9


in this example i would like to move everything along
col1 col2 col3 col4 col5 col6 col7
   1      4      7     8     9

so nulls are always to the right so populations start from col 1 onwards




Public Function UnmatchandRepostion(ClientCode)
Dim db As Database
Set db = CurrentDb
Dim RstMatchData As DAO.Recordset
Dim strSelect As String
Dim strFrom As String
Dim strQuery As String
Dim MatchArray() As Long

strSelect = "SELECT [CapToMvris-CW].MvrisCode, [CapToMvris-CW].CapCode1_1, [CapToMvris-CW].CapCode1_2, [CapToMvris-CW].CapCode1_3, [CapToMvris-CW].CapCode1_4, [CapToMvris-CW].CapCode1_5, [CapToMvris-CW].CapCode1_6, [CapToMvris-CW].CapCode1_7, [CapToMvris-CW].MatchString"
strFrom = " FROM [CapToMvris-CW];"
strQuery = strSelect & strFrom
Set RstMatchData = db.OpenRecordset(strQuery)



With RstMatchData
.MoveFirst

Do While Not .EOF Or .BOF
'traverse each mvriscode and look for clientcode and if found update to null
.Edit
    If ClientCode = .Fields("CapCode1_1").Value Then
        .Fields("CapCode1_1") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_2").Value Then
        .Fields("CapCode1_2") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_3").Value Then
        .Fields("CapCode1_3") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_4").Value Then
        .Fields("CapCode1_4") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_5").Value Then
        .Fields("CapCode1_5") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_6").Value Then
        .Fields("CapCode1_6") = Null
        .Update
    End If
    If ClientCode = .Fields("CapCode1_7") Then
        .Fields("CapCode1_7") = Null
        .Update
    End If

'clean up empty spaces here


.MoveNext
Loop

End With


End Function

Open in new window

PeterBaileyUkAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You could always (a) run through each Field in the REcord and gather the data then (b) go BACK through the fields and delete the data and then (c) go BACK through the fields an drop the data captured in (a) into the fields in a sequential fashion.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jeffrey CoachmanMIS LiasonCommented:

PeterBaileyUk,

Am I missing something...?

How would that work for more than 1 record at a time?
0
PeterBaileyUkAuthor Commented:
ok I have cretaed the first part ok ie for each row in the recordset I can delete a deleted value (clientcode) and then I have stored the capcode values in an array.

The sequential part I am struggling with.

Have attached my code

this works fine

For ArrayIndex = LBound(MatchArray) To UBound(MatchArray)
             If ClientCode = .Fields("CapCode1_" & CStr(ArrayIndex + 1)) Then
             .Fields("CapCode1_" & CStr(ArrayIndex + 1)) = Null
             .Update
             End If
             MatchArray(ArrayIndex) = Nz(.Fields("CapCode1_" & CStr(ArrayIndex + 1)), 0)
Next ArrayIndex

unless you can suggest improvement but it gives an idea boag2000 as to whats going on.

the code above replaces the deleted client codes with nulls which could be in any of 1 of 7 fields.

I want to repopulate the fields in the recordset with the nulls removed.


Public Function UnmatchandRepostion(ClientCode)
Dim db As Database
Set db = CurrentDb
Dim RstMatchData As DAO.Recordset
Dim strSelect As String
Dim strFrom As String
Dim strQuery As String
Dim MatchArray(6) As Long
Dim ArrayIndex As Long
Dim Index2 As Long

strSelect = "SELECT [CapToMvris-CW].MvrisCode, [CapToMvris-CW].CapCode1_1, [CapToMvris-CW].CapCode1_2, [CapToMvris-CW].CapCode1_3, [CapToMvris-CW].CapCode1_4, [CapToMvris-CW].CapCode1_5, [CapToMvris-CW].CapCode1_6, [CapToMvris-CW].CapCode1_7, [CapToMvris-CW].MatchString"
strFrom = " FROM [CapToMvris-CW];"
strQuery = strSelect & strFrom
Set RstMatchData = db.OpenRecordset(strQuery)



With RstMatchData
.MoveFirst

Do While Not .EOF Or .BOF
'traverse each mvriscode and look for clientcode and if found update to null, then store the complete row in array for future null search
.Edit

For ArrayIndex = LBound(MatchArray) To UBound(MatchArray)
             If ClientCode = .Fields("CapCode1_" & CStr(ArrayIndex + 1)) Then
             .Fields("CapCode1_" & CStr(ArrayIndex + 1)) = Null
             .Update
             End If
             MatchArray(ArrayIndex) = Nz(.Fields("CapCode1_" & CStr(ArrayIndex + 1)), 0)
Next ArrayIndex


'now move through array ignoring zero values and populate the columns sequentially
             
             For ArrayIndex = LBound(MatchArray) To UBound(MatchArray)
             For Index2 = 1 To 7 Step 1
                 
                    If MatchArray(ArrayIndex) > 0 Then
                        .Edit
                        .Fields("CapCode1_" & CStr(Index2)) = MatchArray(ArrayIndex)
                        .Update
                    End If
                 
             Next Index2
            Next ArrayIndex
             
             



.MoveNext
Loop

End With


End Function

Open in new window

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

PeterBaileyUkAuthor Commented:
this is done on a record by record basis as the clientcode that needs to be deleted could appear in each record in one of the seven fields.

0
PeterBaileyUkAuthor Commented:
this fails:

'now move through array ignoring zero values and populate the columns sequentially
             
             For ArrayIndex = LBound(MatchArray) To UBound(MatchArray)
             For Index2 = 1 To 7 Step 1
                 
                    If MatchArray(ArrayIndex) > 0 Then
                        .Edit
                        .Fields("CapCode1_" & CStr(Index2)) = MatchArray(ArrayIndex)
                        .Update
                    End If
                 
             Next Index2
            Next ArrayIndex
0
PeterBaileyUkAuthor Commented:
i should have said why it fails as it populates the same value in all the 7 fields
0
Rey Obrero (Capricorn1)Commented:
use this sequence
 * open table as recordset
 * iterate thru the records fields

dim j, datArr()
rs.movefirst
do until rs.eof
   for j=0 to rs.fields.count-1  'change 0 if you don't want to start with first field
       if rs(j) & ""<>"" then
       redim preserve datarr(j)
       datArr(j)=rs(j)
       j=j+1
       end if
       'clear all fields for this particular record
       'codes here to clear
       rs.edit
          for j=0 to rs.fields.count-0
               rs(j).name="" 'or Null
          next
       rs.update

       'edit the record again with gathered data
       rs.edit
       for j=lbound(datArr) to Ubound(datarr)
          rs(j).name=datarr(j)
       next
       rs.update

       'clear array
       datarr(0)=""
   next
rs.movenext
loop
0
PeterBaileyUkAuthor Commented:
thank you
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.