Place A Variable Value into A Column of Existing Data

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,564
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a variable (hgTime) with a time value of 7:15 PM.

I have column of time values (column F) for which I want to insert a blank cell at the point in the column that time (hgTime) would fit in between. So if this is my data ...

task allocation.xlsm
F
134:30P
148:30A
158:30A
169:00A
179:00A
189:00A
191:00P
201:00P
214:30P
225:00P
235:00P
245:00P
256:00P
266:00P
276:00P
286:30P
297:00P
307:00P
317:00P
327:00P
339:00P
Master
Cells with Data Validation
CellAllowCriteria
F13:F25List=nr_dsr2


The value would be placed between rows 32 and 33.

Would anyone be able to help find an efficient VBA solution to accomplish this. I was working with a series of loops, but that felt very awkward and I wasn't getting great results.
 
Sort by date Sort by votes
OK, I'm getting confused now. Let's take this one step at a time.

1. Does the code provided insert cells in the correct range according to the time value hgTime?
2. Is this simply meant to be a blank range of cells (a destination) where you want to copy some other data?
3. Does the source data come from the same sheet? Is it the same sized range of cells?
4. In your code above, have you tried With rng.Cells(rNum, 1).Offset(, -5).Resize(1, 17) to get the full range of cells needing to be copied?
5. You could probably lose the + 1 at the end of rNum = Application.Match(CDbl(svc_time), rng, 1) + 1

This would be so much easier if you could provide your actual data using the XL2BB Tool and your entire code rather than just a snippet.

Cheers ;)
 
Upvote 0

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Hi Kevin, thank you for your continued support. I hope what I provided below helps.

1. In further testing ... no. Follow the series of illustrations provided. Illustration 1 shows the data set prior to inserting of any rows. Illustration 2 shows the dataset after the data set has had a row inserted. You will see that a row filled with 0's has been inserted at row 34, which is correct based on hgTime = 7:15 PM. Finally, the third illustration shows the pasted data, which was pasted at Row 21, not at row 34 where it should go.
2. Correct. In Illustration #2, the range of cells A34:Q34 is supposed to be copied to the empty range created.
3. Source of the data to be copied and pasted comes from the same sheet. Source is A34:Q34 with a destination of A(new row):Q(new row). New row should be 34, but as seen in illustration 3, it's going to row 21 (which is the value of rNum. I understood it that rNum was the row that should be inserted)
4. Yes. It was what gave me the range of zeros at row 34
5. Untested

Here is my full code:
Rich (BB code): 
Sub iupdate_srvcpda()
    Dim hgTime As Double, rng As Range, rNum As Long
    Application.ScreenUpdating = False
    'Stop
    With ws_master
        mbevents = False
        .Unprotect
        srvcs_no = Application.WorksheetFunction.CountA(ws_thold.Range("AK1:AK8"))
        scol = 13 '14, 15, 16
        srccol = 1 '2-8
        srvc_drow = Application.WorksheetFunction.Match("ADD", .Columns(1)) ' + 1
'Stop 'try save      SAVE OK
        For L1 = 1 To srvcs_no
            If srvc_drow > 32 Then 'add row
                'srvc_drow = srvc_drow + 1
                'MsgBox "Not enough room. Row added at " & svc_drow + 1, , "UNTESTED"
                MsgBox "Not enough room. Row added at " & srvc_drow, , "UNTESTED"
                'Stop
                '.Range("A" & srvc_drow & ":R" & srvc_drow - 1).Insert Shift:=xlDown
                .Range("A" & srvc_drow & ":R" & srvc_drow).Insert Shift:=xlDown
            End If
            With .Range("H" & srvc_drow & ":Q" & srvc_drow)
                .Cells.Value = ""
                .Cells.Interior.Color = RGB(166, 166, 166)
                .Cells.locked = True
            End With
            If L1 = 5 Then
                scol = scol - 4
            End If
            Set rng_cpy = ws_master.Range("A" & srow & ":G" & srow)
            rng_cpy.Copy ws_master.Range("A" & srvc_drow)
            With .Cells(srvc_drow, scol)
                .Value = ws_thold.Cells(srccol, 39)
                .Interior.ColorIndex = 0
            End With
            If ws_thold.Cells(srccol, 36) = "RLN" Then
                d1 = "Reline"
            Else
                d1 = "Change"
            End If
            dmsg = d1 & " " & ws_thold.Cells(srccol, 37) & "-" & ws_thold.Cells(srccol, 38)
            With .Cells(srvc_drow, 2)
                .Font.Size = 6
                .Font.Color = vbBlack
                .Font.Bold = True
                .Value = dmsg
                .HorizontalAlignment = xlCenter
            End With
            With .Cells(srvc_drow, 8) '.Cells(srvc_drow, 18)
                .Value = ws_thold.Cells(srccol, 43)
                .Font.Size = 6
                .Font.Color = vbBlue 'RGB(229, 242, 251)
            End With
'Stop 'try save      SAVE OK
            .Rows(srvc_drow).AutoFit
            .Rows(srvc_drow).Cells.locked = True
            .Range(.Cells(srvc_drow, 1), .Cells(srvc_drow, 17)).VerticalAlignment = xlCenter
            scol = scol + 1
            srccol = srccol + 1
            srvc_drow = srvc_drow + 1
        Next L1
Stop

'(1) start process here - worksheet in illustration 1 state
'SORT RANGE WITH SERVICES
        hgTime = .Cells(srvc_drow - 1, 8).Value
        Debug.Print hgTime & " (" & Format(hgTime, "h:mm AM/PM")
        'Set rng = Range("F13", Cells(Rows.Count, "F").End(3))
        Set rng = .Range("F13:F" & srvc_drow - 1)
        rNum = Application.Match(CDbl(hgTime), rng, 1) + 1
        With rng.Cells(rNum, 1).Offset(, -5).Resize(1, 17)
             .Offset(-1).Value = hgTime
        End With
        '(2) worksheet in illustration 2 state
        .Range("A" & srvc_drow - 1 & ":Q" & srvc_drow - 1).Copy .Range("A" & rNum & ":Q" & rNum)
        '(3) worksheet in illustration 3 state
        
        .Protect
        mbevents = True
    End With
    Application.ScreenUpdating = True
'Stop 'try save      SAVE FAILS
End Sub

Illustration 1 - represents the data set at point (1) in the code. Notice the data in A34:Q34. This is the data to be copied to the new row inserted based on the value of hgTime which is 7:15 PM. In this case of testing, the new open range should be put at row 32/33. (between 7:00 PM and 9:00P). srvc_drow = 35

task allocation.xlsm
ABCDEFGHIJKLMNOPQ
12
1344779011iniR3713xxxxxxxxxxxxxxxxxxxx8:30A12:00PRPE1RPE1
1444779006iniR3568xxxxxxxxxxxxxxxxxxxx8:30A4:30PHPE1HPE1
1544779017iniR3999xxxxxxxxxxxxxxxxxxxx9:00A12:00PRPE1RPE1
1644779020iniR3868xxxxxxxxxxxxxxxxxxxx9:00A12:00PWPE1WPE1
1744779016iniR4228xxxxxxxxxxxxxxxxxxxx9:00A2:00PRPE1RPE1
1844779018FRR3999xxxxxxxxxxxxxxxxxxxx1:00P4:00PRPE1RPE1
1944779012FRR3713xxxxxxxxxxxxxxxxxxxx1:00P4:30PRPE1RPE1
2044779001iniR3610xxxxxxxxxxxxxxxxxxxx4:30P8:15PCUE1BPL1BPL1BPL1
2144779007iniR3654xxxxxxxxxxxxxxxxxxxx4:30P8:30PCUE1WPL1WPL1WPL1
2244779019iniR4131xxxxxxxxxxxxxxxxxxxx5:00P8:00PWPL1WPL1
2344779010iniR4108xxxxxxxxxxxxxxxxxxxx5:00P8:30PRPL1RPL1
2444779005iniR4070xxxxxxxxxxxxxxxxxxxx5:00P9:00PWPL1WPL1
2544779021iniR4196xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1WPL1WPL1WPL1
2644779003iniR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1HPL1HPL1HPL1CUL1HPL1HPL1
2744779004DTR4227xxxxxxxxxxxxxxxxxxxx6:00P10:30P
2844779009FRR3677xxxxxxxxxxxxxxxxxxxx6:30P8:30P
2944779013FRR3955xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3044779014FRR3960xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3144779002DRR4213xxxxxxxxxxxxxxxxxxxx7:00P9:00P
3244779015FRR4085xxxxxxxxxxxxxxxxxxxx7:00P9:00P
3344779008FRR4219xxxxxxxxxxxxxxxxxxxx9:00P11:00P
3444779003Reline 7:15P-7:30PR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30P0.8020833HPL1
35ADD
36
Master
Cells with Data Validation
CellAllowCriteria
F13:F26List=nr_dsr2
F34List=nr_dsr2


Illustration 2 - represents the data set at point (2). Note that the new range with values equal to hgTime has been inserted at the right spot. Row 32. This will be the destination range of the copied range A34:Q34. rNum = 21.

task allocation.xlsm
ABCDEFGHIJKLMNOPQ
12
1344779011iniR3713xxxxxxxxxxxxxxxxxxxx8:30A12:00PRPE1RPE1
1444779006iniR3568xxxxxxxxxxxxxxxxxxxx8:30A4:30PHPE1HPE1
1544779017iniR3999xxxxxxxxxxxxxxxxxxxx9:00A12:00PRPE1RPE1
1644779020iniR3868xxxxxxxxxxxxxxxxxxxx9:00A12:00PWPE1WPE1
1744779016iniR4228xxxxxxxxxxxxxxxxxxxx9:00A2:00PRPE1RPE1
1844779018FRR3999xxxxxxxxxxxxxxxxxxxx1:00P4:00PRPE1RPE1
1944779012FRR3713xxxxxxxxxxxxxxxxxxxx1:00P4:30PRPE1RPE1
2044779001iniR3610xxxxxxxxxxxxxxxxxxxx4:30P8:15PCUE1BPL1BPL1BPL1
2144779007iniR3654xxxxxxxxxxxxxxxxxxxx4:30P8:30PCUE1WPL1WPL1WPL1
2244779019iniR4131xxxxxxxxxxxxxxxxxxxx5:00P8:00PWPL1WPL1
2344779010iniR4108xxxxxxxxxxxxxxxxxxxx5:00P8:30PRPL1RPL1
2444779005iniR4070xxxxxxxxxxxxxxxxxxxx5:00P9:00PWPL1WPL1
2544779021iniR4196xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1WPL1WPL1WPL1
2644779003iniR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1HPL1HPL1HPL1CUL1HPL1HPL1
2744779004DTR4227xxxxxxxxxxxxxxxxxxxx6:00P10:30P
2844779009FRR3677xxxxxxxxxxxxxxxxxxxx6:30P8:30P
2944779013FRR3955xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3044779014FRR3960xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3144779002DRR4213xxxxxxxxxxxxxxxxxxxx7:00P9:00P
320.802083330.8020830.80208330.8020833330.8020833337:15P7:15P0.80208330.80208330.80208330.80208330.80208330.80208330.80208330.80208330.80208330.8020833
3344779008FRR4219xxxxxxxxxxxxxxxxxxxx9:00P11:00P
3444779003Reline 7:15P-7:30PR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30P0.8020833HPL1
35ADD
36
Master
Cells with Data Validation
CellAllowCriteria
F13:F26List=nr_dsr2
F34List=nr_dsr2


Illustration 3 - represents the data set at point (3) after range A34:Q34 was copied and pasted to ArNUM:QrNUM. Notice how the A34:Q34 range of copied data was pasted at A21:Q21 (rNum) and the inserted row remains unchanged. That ranged should have been pasted at range A32:Q32. WIth rNum equal to 21 that makes sense, but what value represents where the range was to be inserted? What value was used to insert the new range at row 34 when rNum = 21?

task allocation.xlsm
ABCDEFGHIJKLMNOPQ
12
1344779011iniR3713xxxxxxxxxxxxxxxxxxxx8:30A12:00PRPE1RPE1
1444779006iniR3568xxxxxxxxxxxxxxxxxxxx8:30A4:30PHPE1HPE1
1544779017iniR3999xxxxxxxxxxxxxxxxxxxx9:00A12:00PRPE1RPE1
1644779020iniR3868xxxxxxxxxxxxxxxxxxxx9:00A12:00PWPE1WPE1
1744779016iniR4228xxxxxxxxxxxxxxxxxxxx9:00A2:00PRPE1RPE1
1844779018FRR3999xxxxxxxxxxxxxxxxxxxx1:00P4:00PRPE1RPE1
1944779012FRR3713xxxxxxxxxxxxxxxxxxxx1:00P4:30PRPE1RPE1
2044779001iniR3610xxxxxxxxxxxxxxxxxxxx4:30P8:15PCUE1BPL1BPL1BPL1
2144779003Reline 7:15P-7:30PR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30P0.8020833HPL1
2244779019iniR4131xxxxxxxxxxxxxxxxxxxx5:00P8:00PWPL1WPL1
2344779010iniR4108xxxxxxxxxxxxxxxxxxxx5:00P8:30PRPL1RPL1
2444779005iniR4070xxxxxxxxxxxxxxxxxxxx5:00P9:00PWPL1WPL1
2544779021iniR4196xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1WPL1WPL1WPL1
2644779003iniR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30PCUE1HPL1HPL1HPL1CUL1HPL1HPL1
2744779004DTR4227xxxxxxxxxxxxxxxxxxxx6:00P10:30P
2844779009FRR3677xxxxxxxxxxxxxxxxxxxx6:30P8:30P
2944779013FRR3955xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3044779014FRR3960xxxxxxxxxxxxxxxxxxxx7:00P8:30P
3144779002DRR4213xxxxxxxxxxxxxxxxxxxx7:00P9:00P
320.802083330.8020830.8020833xxxxxxxxxxxxxxxxxxxx7:15P7:15P0.80208330.80208330.80208330.80208330.80208330.80208330.80208330.80208330.80208330.8020833
3344779008FRR4219xxxxxxxxxxxxxxxxxxxx9:00P11:00P
3444779003Reline 7:15P-7:30PR4227xxxxxxxxxxxxxxxxxxxx6:00P8:30P0.8020833HPL1
35ADD
36
Master
Cells with Data Validation
CellAllowCriteria
F34List=nr_dsr2
F13:F26List=nr_dsr2
 
Upvote 0
OK, I see where the problem is. The variable rNum is based on a search of the range starting from row 13, whereas you use it later in your code starting from row 1. I can't test your entire code because things are still missing - a number of variables are used early in the module (ws_master for example) that aren't Set in the code prior to their use. Having said that, see if the following snippet, an amendment of my first code, gives you the part you want.

VBA Code: 
Sub Insert_Time_v2()
    Dim hgTime As Double, rng As Range, rNum As Long, srcRow As Long
   
    hgTime = 0.802083333333333      '<< ~~ left like this for demonstration purposes
   
    Set rng = Range("F13", Cells(Rows.Count, "F").End(3))
    rNum = Application.Match(CDbl(hgTime), rng, 1) + 1
   
    With rng.Cells(rNum, 1)
        .EntireRow.Insert
    End With
   
    srcRow = Application.Match("ADD", Columns(1), 0) - 1
   
    Cells(srcRow, 1).EntireRow.Copy rng.Cells(rNum, 1).Offset(, -5)
   
End Sub
 
Upvote 0
Solution
You're awesome! Thank you so much Kevin. Not only did you get things working for me, but you provided some much valued education.
 
Upvote 0
Ark68 said:
You're awesome! Thank you so much Kevin. Not only did you get things working for me, but you provided some much valued education.
Click to expand...
You're welcome and thanks for the feedback ?
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Moving lines of a 2D array to a second 2D array based on a condition
Replies
3
Views
306
Peter_SSs
Peter_SSs
theYaniac
  • Solved
I would like to insert a blank row between each new unique identifier in column A.
Replies
3
Views
242
MARK858
MARK858
N
  • Solved
VBA to insert rows in sheet 2 (parts list) at row 5,& move existing datas down while inserting new rows,when drop down value is selected on E4 sheet1.
Replies
8
Views
361
nscaria00
N
S
  • Question
Trendline values using Dynamic Range in Excel - comparing with LINEST function
Replies
1
Views
303
Domenic
D
S
  • Question
Program Button to Find, Copy, Paste to New Sheet based on Value in column
Replies
0
Views
179
samss919
S

Forum statistics

Threads
1,215,772
Messages
6,126,806
Members
449,337
Latest member
BBV123

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top