• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

Add data to a cell in a range based on column value|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / Add data to a cell in a range based on column value|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosAdd data to a cell in a range based…
sp_PrintTopic sp_TopicIcon
Add data to a cell in a range based on column value
Avatar
Shawn Wallack
Member
Members
Level 0
Forum Posts: 77
Member Since:
December 7, 2021
sp_UserOfflineSmall Offline
1
June 20, 2022 - 12:53 pm
sp_Permalink sp_Print

I have a workbook with several user forms/ I want to save their last used positions to a table called TABLE_FORM_POSITIONS (rather than read/write to the registry). 

As you can see from the attached sample XLS, I use the LAYOUT change event to save the form position. When the form is initialized/shown it retrieves the last saved position and opens it there.

So reading from the table is no problem (although there may be better ways than the one I'm using). The problem is WRITING to the table.  

I'm not sure the best way to save the form position to the table on the hidden sheet.

Thanks!

sp_AnswersTopicSeeAnswer See Answer
Avatar
Velouria
London or thereabouts
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 627
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
2
June 20, 2022 - 5:44 pm
sp_Permalink sp_Print

You could do something like this (I assume you will expand your table for the other two variables, but I haven't added the lines for those):

 

Sub SaveFormTopLeft(ByVal FormName As String, ByVal lLeft As Long, ByVal lTop As Long, ByVal lWidth As Long, ByVal lheight As Long)

' 1 - Look in the first column (Col A) of the "TABLE_FORM_POSITIONS" table
' 2 - Match the form name passed to this procedure as a parameter
' 3 - If match found then save lLeft value in table's 2nd column and lTop value in the 3rd column
' 4 - If no match then create a rown in the table so it will be found next time
Dim FormTable As ListObject
Set FormTable = shCounts.ListObjects("TABLE_FORM_POSITIONS")
Dim RowNum
RowNum = Application.Match(FormName, FormTable.ListColumns("Form").DataBodyRange, 0)
Dim DataRow As ListRow
If IsError(RowNum) Then ' form name not found
Set DataRow = FormTable.ListRows.Add
Else
Set DataRow = FormTable.ListRows(RowNum)
End If
With DataRow
.Range(1, FormTable.ListColumns("Form").Index).Value = FormName
.Range(1, FormTable.ListColumns("Left").Index).Value = lLeft
.Range(1, FormTable.ListColumns("Top").Index).Value = lTop
End With
End Sub

sp_AnswersTopicAnswer
Answers Post
Avatar
Shawn Wallack
Member
Members
Level 0
Forum Posts: 77
Member Since:
December 7, 2021
sp_UserOfflineSmall Offline
3
June 24, 2022 - 6:29 am
sp_Permalink sp_Print

Thank you. I ended up with the following, and it works like a charm...

*** CODE IN A MODULE ***

Sub SaveFormTopLeft(ByVal FormName As String, ByVal lLeft As Long, ByVal lTop As Long, ByVal lWidth As Long, ByVal lheight As Long)
Dim FormTable As ListObject
Dim RowNum
Dim DataRow As ListRow
Set FormTable = shCounts.ListObjects("TABLE_FORM_POSITIONS")
RowNum = Application.Match(FormName, FormTable.ListColumns("Form").DataBodyRange, 0)
If IsError(RowNum) Then ' Form name not found in table
Call LockSheet(False, shCounts.Index) ' Unprotect sheet
Set DataRow = FormTable.ListRows.Add ' Add row
Call LockSheet(True, shCounts.Index) ' Protect sheet
Else
Set DataRow = FormTable.ListRows(RowNum)
End If
With DataRow
.Range(1, FormTable.ListColumns("Form").Index).Value = FormName
.Range(1, FormTable.ListColumns("Left").Index).Value = lLeft
.Range(1, FormTable.ListColumns("Top").Index).Value = lTop
End With
End Sub


Function GetFormLeft(ByVal FormName As String, ByVal dWidth As Double) As Double
Dim sRes As String
Dim dLeft As Double
Dim dCenter As Double
dCenter = Int(Application.Left + (Application.UsableWidth / 2) - (dWidth / 2))
On Error Resume Next ' Needed in case no value is found
' VLookup (value, array, index, match type)
sRes = Application.WorksheetFunction.VLookup(FormName, Range("TABLE_FORM_POSITIONS"), 3, False)
If Err.Number = 0 Then
dLeft = sRes
Else
dLeft = dCenter
End If
GetFormLeft = dLeft
End Function


Public Function GetFormTop(ByVal FormName As String, ByVal dHeight As Double) As Double
Dim sRes As String
Dim dTop As Double
Dim dCenter As Double
dCenter = Int(Application.Top + (Application.UsableHeight / 2) - (dHeight / 2))
On Error Resume Next ' Needed in case no value is found
' VLookup (value, array, index, match type)
sRes = Application.WorksheetFunction.VLookup(FormName, Range("TABLE_FORM_POSITIONS"), 2, False)
If Err.Number = 0 Then
dTop = sRes
Else
dTop = dCenter
End If
GetFormTop = dTop
End Function

**** CODE IN THE FORM ****

Private Sub UserForm_Activate()
' Restore last saved position
Me.Top = GetFormTop(Me.Name, Me.Height)
Me.Left = GetFormLeft(Me.Name, Me.Width)
End Sub

Private Sub UserForm_Initialize()
' Restore last saved position
Me.Top = GetFormTop(Me.Name, Me.Height)
Me.Left = GetFormLeft(Me.Name, Me.Width)
End Sub

Private Sub UserForm_Layout()
' Save position whenever the form moves
Call SaveFormTopLeft(Me.Name, Me.Left, Me.Top, Me.Width, Me.Height)
End Sub
sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: stuart burge
Guest(s) 10
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 871
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
Jessica Stewart: 205
A.Maurizio: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
stuart burge
Bruce Tang Nian
Scot C
Othman AL MUTAIRI
Misael Gutierrez Sr.
Attif Ihsan
Kieran Fee
Murat Hasanoglu
Brett Dryland
Saeed Aldousari
Forum Stats:
Groups: 3
Forums: 24
Topics: 6223
Posts: 27294

 

Member Stats:
Guest Posters: 49
Members: 31919
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.