How to Update my Links :(

yorkbay

New Member
Joined
Feb 7, 2021
Messages
18
Office Version
  1. 2013
Platform
  1. Windows
Hi - I have a workbook with 10 sheets
I created a copy\link from Sheet1 to Sheet1
Sheet 1 contains 'code' in column F
Users fill out column F for one group then click save which moves the completed data to G, H, I for as many groups as they fill out
There is another button on Sheet 1 that says 'change data'. Rather than have code in every column I have all my code in column F.
The macro asks the user 'which column is the data in'
They enter column i.e. H
The macro moves the group with all data in column H over to column F for any updates then upon save, moves it to the first blank column and removes the blank original column H - reason for this is because when the pop up box asks the user which column they need to change, and moves it to F, I couldn't determine how to find 'where it came from' but knew how to tell it to put the new saved version in first blank and remove the 'in between' blank column
This of course causes the link on Sheet 2 to change to #REF!
Sheet 2 still has the column data but it now resides in F, X and AO
How can I fix this? TIA
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Instead of deleting the column H move all of the data left one column which you can do using this code:
VBA Code:
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 9), Cells(lastrow, lastcol))
Range(Cells(1, 8), Cells(lastrow, lastcol - 1)) = inarr
this does it without changing any references
 
Upvote 0
Instead of deleting the column H move all of the data left one column which you can do using this code:
VBA Code:
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
inarr = Range(Cells(1, 9), Cells(lastrow, lastcol))
Range(Cells(1, 8), Cells(lastrow, lastcol - 1)) = inarr
this does it without changing any references
Thank you very much, but I have the issue of not knowing 'H'. My code provides an Input Box where the user defined column H as the column that they wanted to update information for. Then my vba code moves H 1:120 over to F for updates. The 'Save' vba then moves the updated information to the first blank column which moves to the end of all data. Because of this I then delete any blank columns which blows out my ref on sheet 2. Here is my 'change' code and my 'save' code. I very much appreciate the assistance!
Change Button Code:
Private Sub Change_Policy_Punch_And_Schedules()
'
'Sub Update_Or_Change_Responses_Punch_Schedules_Tab()

'unlocks sheet
Worksheets("Punch & Schedules").Protect Password:="simple123", UserInterfaceOnly:=True

'Punch & Schedules Tab Change Responses to Completed Groups'

Dim strCol As String
strCol = InputBox("Please Specify Which Column The Policy That Needs to Be Updated or Changed Resides")
If strCol = "" Then
Msgbox "You didn't specify a column! Please Try Again!", vbCritical
Exit Sub
End If
Range(strCol & "1:" & strCol & "120").Select
' ActiveWindow.SmallScroll Down:=117
Selection.Copy
Range("F1:F120").PasteSpecial xlPasteValuesAndNumberFormats
Columns(strCol).Select
Selection.ClearContents
Range("F2").Select
End Sub

Save Button Code
Private Sub Submit_After_Punch_Schedules_NEW()
'
'Submit_After_Punch_Schedules_NEW

' FIRST test for NO Blank Responses Checks responses to ensure nothing left blank before moving to Next Group Tab or Next Group

Application.ScreenUpdating = False

Dim myCellRange As Range
Set myCellRange = Range("F1:F120").SpecialCells(xlCellTypeVisible)
Range("F1:F120").SpecialCells(xlCellTypeVisible).Select

'check if cell is empty. Depending on result, display message box indicating whether cell is empty (True) or not empty (False)
If WorksheetFunction.CountA(myCellRange) < myCellRange.Count Then
Msgbox "ALL Questions MUST contain a Response. For Salary Code and Rate Cells Enter the word 'REVISIT' if you are not able to provide the information at this time. For Cells with Drop Down Selections Choose either 'Revisit' if the response is not know. Or, choose 'Other' (where available), to provide a response that was not contained in the dropdown. Cells requiring attention are highlighted in 'PINK'. Please select a response for each."
Range("$F$2").Select

Exit Sub

End If

'Save Button after Punch & Schedules requirements capture; copies captured data to 1st blank column to right, removes any 'middle blank columns' in case used 'update', removes name in F, unhides all questions and asks user if they with to return to Index for next 'yes'

Range("F1:F121").Copy
Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("F1:F120").ClearContents

'**Unhide All Questions for This Sheet
Rows("1:120").Select
Selection.EntireRow.Hidden = False

'**Delete Blank Columns
Dim iCntr
Dim rng As Range
Set rng = Range("G1:Z120")

For iCntr = rng.Column + rng.Columns.Count - 1 To rng.Column Step -1
If Application.WorksheetFunction.CountA(Columns(iCntr)) = 0 Then Columns(iCntr).EntireColumn.Delete
Next

Range("F1").Select

AnswerYes = Msgbox("Would You Like To Return To The Index Page To Add More Policy Rules?", vbQuestion + vbYesNo, "User Response")

If AnswerYes = vbYes Then
Sheets("Index").Select
Msgbox "Please make the policy rules selection to work on next"
Range("$F$2").Select
Else

Range("F2").Select
Msgbox "Use The Return To Index Button In the Top Left of The Screen To Return To The Index At Any Time."
Msgbox "REMINDER: If you haven't done so recently, please SAVE your file before proceeding"
End If

Application.ScreenUpdating = True

End Sub
 
Upvote 0
you can use the idea I suggested by replacing this code:
VBA Code:
'**Delete Blank Columns
Dim iCntr
Dim rng As Range
Set rng = Range("G1:Z120")

For iCntr = rng.Column + rng.Columns.Count - 1 To rng.Column Step -1
If Application.WorksheetFunction.CountA(Columns(iCntr)) = 0 Then Columns(iCntr).EntireColumn.Delete
Next

with this code:
VBA Code:
inarr = Range("G1:Z120")
Range("G1:Z120") = ""
outarr = Range("G1:Z120")

For i = 1 To 20 ' loop through each column
 colno = 1
 countzero = 0
  For j = 1 To 120
    outarr(j, colno) = inarr(j, i)
    If inarr(j, i) <> 0 Then
     countzero = countzero + 1
    End If
  Next j
  If countzero > 0 Then
  colno = colno + 1
 End If

Next i
Range("G1:Z120") = outarr
 
Upvote 0
I realised my code waasn't quite right this line:
VBA Code:
If inarr(j, i) <> 0 Then
should be
VBA Code:
If inarr(j, i) <> "" Then
or
VBA Code:
If not(isempty(inarr(j, i))) Then
 
Upvote 0
Hi - Thank you for the response but I think this only works if they select H. Selecting column H was just an example (i.e.) They can choose any column ... how would I be able to accommodate your advice with that unknown?
 
Upvote 0
You have stated your problem as get a #REF appearing when you delete various columns. So code I have given gets over that problem but does the same thing , i.e instead of deleting the column it moves the data. so it should work regardless of of what happens before of after, i.e whatever column they select.. So try doing what i suggested replacing the 6 lines of your code where you delete various columns with the code that i have given you. ( including the correction in my post '#5)
 
Upvote 0
Thank you for this help, but what it does is remove all columns even those that have data :( I rem'd out my code and replaced and your code plus the correction. Thoughts?
'**Delete Blank Columns
'Dim iCntr
'Dim rng As Range
'Set rng = Range("G1:Z120")

' For iCntr = rng.Column + rng.Columns.Count - 1 To rng.Column Step -1
' If Application.WorksheetFunction.CountA(Columns(iCntr)) = 0 Then Columns(iCntr).EntireColumn.Delete
' Next

'***NEW to accomodate the flat page view so won't get REF error

inarr = Range("G1:Z121")
Range("G1:Z121") = ""
outarr = Range("G1:Z121")

For i = 1 To 20 ' loop through each column
colno = 1
countzero = 0
For j = 1 To 121
outarr(j, colno) = inarr(j, i)
If inarr(j, i) <> "" Then
countzero = countzero + 1
End If
Next j
If countzero > 0 Then
colno = colno + 1
End If

Next i
Range("G1:Z121") = outarr

I had data in columns G and H, used my update button to select G to update and then used the new save button. All columns are now blank :(
 
Upvote 0
Very sorry my mistake I didn't test it, try this code which just moves the Colno=1 outside the loop
VBA Code:
inarr = Range("G1:Z121")
Range("G1:Z121") = ""
outarr = Range("G1:Z121")
colno = 1

For i = 1 To 20 ' loop through each column
countzero = 0
For j = 1 To 121
outarr(j, colno) = inarr(j, i)
If inarr(j, i) <> "" Then
countzero = countzero + 1
End If
Next j
If countzero > 0 Then
colno = colno + 1
End If

Next i
Range("G1:Z121") = outarr
 
Upvote 0
ahhh bless your heart that works and I am learning so I actually 'think' I understand it. I'm going to post my next issue with my file and I'm hoping you will be the one to respond as you just saved me from disaster. Thank you again!
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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