Can vba return excel cell value with formats

T

thatboyp

New Member
Joined
Jan 25, 2005
Messages
6
Hi,

I have two tabs in a workbook. the first tab is to entry data and the second tab act like a database. The first tab - I got one button that will save and a second one that will pull the data from the database and populate the values into the same cell. The button that does the populating the cell is a pull down box. When an item is selected from the pull down it will populate all the data into the right cell that I reference. I can make changes into these cell, once I am done update information into these cell, I hit the save button and it save the the data into the database.

When I do the updating with new data I highlight the text to blue font. The old text are kept in black font.

Here is the problem I need help on: When I do the pull down from the first button to retrieve the data - all the text are converted to BLACK font. When this happen the people that look at my first tab don't know what have been updated because all the text are black font now. The blue font are not save to the database on tab number two. Is there a vb code to get the value pull from the database and the format too?

I can attach my file for someone to review it...

Thanks,

Peter
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Hi Jen, here are the codes. I copy the VB copy from another file and modify it to used for my requirements.

Sub SaveWingDATA()

'Update data on Sheet1 based on changes made to data on Sheet2

Dim LProject As Integer

Dim LIssue As String
Dim LResponsible As String
Dim LBORIS As String
Dim LDaysonReport As String
Dim LBackupFocal As String
Dim LDALPFocal As String
Dim LProblem As String
Dim LRootCause As String
Dim LEngagement As String
Dim LProgress As String
Dim LNextStep As String
Dim LHelpNeeded As String
Dim LImpact As String
Dim LReWork As String
Dim LReportingFocal As String
'Dim LTeamStatusCurrent As String
'Dim LWatchRiskLastWeek As String
'Dim LWatchRiskCurrent As String
'Dim L4SQDate As String

Dim LRow As Long
Dim LFound As Boolean
Dim nextRow As Integer

'Retrieve project number number
LProject = Range("E3").Value

'Retrieve new address and phone number information



LIssue = Range("F7").Value
LResponsible = Range("F9").Value
LBORIS = Range("I9").Value
LDaysonReport = Range("K9").Value
LBackupFocal = Range("I10").Value
LDALPFocal = Range("K10").Value
LProblem = Range("F12").Value
LRootCause = Range("F16").Value
LEngagement = Range("F20").Value
LProgress = Range("E24").Value
LNextStep = Range("E31").Value
LHelpNeeded = Range("E38").Value
LImpact = Range("E43").Value
LReWork = Range("E48").Value
LReportingFocal = Range("F10").Value



'Move to Sheet1 to save the changes
Sheets("WING LCPT Database").Select

LFound = False

LRow = 2

Do While LFound = False
'Found matching project, now update address and phone number information
If Range("A" & LRow).Value = LProject Then
LFound = True
Range("B" & LRow).Value = LIssue
Range("C" & LRow).Value = LResponsible
Range("D" & LRow).Value = LBORIS
Range("E" & LRow).Value = LDaysonReport
Range("F" & LRow).Value = LBackupFocal
Range("G" & LRow).Value = LDALPFocal
Range("H" & LRow).Value = LProblem
Range("I" & LRow).Value = LRootCause
Range("J" & LRow).Value = LEngagement
Range("K" & LRow).Value = LProgress
Range("L" & LRow).Value = LNextStep
Range("M" & LRow).Value = LHelpNeeded
Range("N" & LRow).Value = LImpact
Range("O" & LRow).Value = LReWork
Range("P" & LRow).Value = LReportingFocal


'Encountered a blank project number (assuming end of list on Sheet1)
ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
MsgBox ("No match was found. Changes were not made.")
Exit Sub
End If

LRow = LRow + 1
Loop

'Reposition back on Sheet2
Sheets("Wing LCPT").Select
Range("J1").Select

MsgBox ("Changes were successfully saved.")

End Sub
 
Upvote 0
Hi Jen,

Thanks for the quick response!

The cell might contain a body of texts. The font are color "Blue" by the person that updating new information to the cell. it turn back to black by the person that updated the information. the rule we used are old information is black and new added information are highlighted in blue font.

Thanks,

Peter
 
Upvote 0
Try this:
Code: 
Sub SaveWingDATA()

'Update data on Sheet1 based on changes made to data on Sheet2

Dim LProject As Integer

Dim LIssue As String
Dim LResponsible As String
Dim LBORIS As String
Dim LDaysonReport As String
Dim LBackupFocal As String
Dim LDALPFocal As String
Dim LProblem As String
Dim LRootCause As String
Dim LEngagement As String
Dim LProgress As String
Dim LNextStep As String
Dim LHelpNeeded As String
Dim LImpact As String
Dim LReWork As String
Dim LReportingFocal As String
'Dim LTeamStatusCurrent As String
'Dim LWatchRiskLastWeek As String
'Dim LWatchRiskCurrent As String
'Dim L4SQDate As String

Dim LRow As Long
Dim LFound As Boolean
Dim nextRow As Integer

'Retrieve project number number
LProject = Range("E3").Value

'Retrieve new address and phone number information



LIssue = Range("F7").Value
LResponsible = Range("F9").Value
LBORIS = Range("I9").Value
LDaysonReport = Range("K9").Value
LBackupFocal = Range("I10").Value
LDALPFocal = Range("K10").Value
LProblem = Range("F12").Value
LRootCause = Range("F16").Value
LEngagement = Range("F20").Value
LProgress = Range("E24").Value
LNextStep = Range("E31").Value
LHelpNeeded = Range("E38").Value
LImpact = Range("E43").Value
LReWork = Range("E48").Value
LReportingFocal = Range("F10").Value



'Move to Sheet1 to save the changes
Sheets("WING LCPT Database").Select

LFound = False

LRow = 2

Do While LFound = False
'Found matching project, now update address and phone number information
If Range("A" & LRow).Value = LProject Then
LFound = True
Range("B" & LRow).Value = LIssue
Range("C" & LRow).Value = LResponsible
Range("D" & LRow).Value = LBORIS
Range("E" & LRow).Value = LDaysonReport
Range("F" & LRow).Value = LBackupFocal
Range("G" & LRow).Value = LDALPFocal
Range("H" & LRow).Value = LProblem
Range("I" & LRow).Value = LRootCause
Range("J" & LRow).Value = LEngagement
Range("K" & LRow).Value = LProgress
Range("L" & LRow).Value = LNextStep
Range("M" & LRow).Value = LHelpNeeded
Range("N" & LRow).Value = LImpact
Range("O" & LRow).Value = LReWork
Range("P" & LRow).Value = LReportingFocal
Range("B" & LRow & ":P" & LRow).Font.Color = -4165632

'Encountered a blank project number (assuming end of list on Sheet1)
ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
MsgBox ("No match was found. Changes were not made.")
Exit Sub
End If

LRow = LRow + 1
Loop

'Reposition back on Sheet2
Sheets("Wing LCPT").Select
Range("J1").Select

MsgBox ("Changes were successfully saved.")

End Sub

If this is not the shade of blue that you need. Record a macro where you color text the shade you want and then update the Color # in the above code.
 
Upvote 0
Hi Jen,

when I try to populate the data again, it turn the font back to black. it doesn't retain the old format or font color in the cell. here is my copy for populating the sheet with the data from the database sheet.

Sub PopulateWing()

Dim LProject As Integer
Dim LIssue As String
Dim LResponsible As String
Dim LBORIS As String
Dim LDaysonReport As String
Dim LBackupFocal As String
Dim LDALPFocal As String
Dim LProblem As String
Dim LRootCause As String
Dim LEngagement As String
Dim LProgress As String
Dim LNextStep As String
Dim LHelpNeeded As String
Dim LImpact As String
Dim LReWork As String
Dim LReportingFocal As String


Dim LRow As Long
Dim LFound As Boolean

'Retrieve project number number
LProject = Range("E3").Value

'Move to Sheet
Sheets("WING LCPT Database").Select

LFound = False

LRow = 2

Do While LFound = False
'Found matching project, now update address and phone number information on Sheet2
If Range("A" & LRow).Value = LProject Then
LFound = True
LIssue = Range("B" & LRow).Value
LResponsible = Range("C" & LRow).Value
LBORIS = Range("D" & LRow).Value
LDaysonReport = Range("E" & LRow).Value
LBackupFocal = Range("F" & LRow).Value
DALPFocal = Range("G" & LRow).Value
LProblem = Range("H" & LRow).Value
LRootCause = Range("I" & LRow).Value
LEngagement = Range("J" & LRow).Value
LProgress = Range("K" & LRow).Value
LNextStep = Range("L" & LRow).Value
LHelpNeeded = Range("M" & LRow).Value
LImpact = Range("N" & LRow).Value
LReWork = Range("O" & LRow).Value
LReportingFocal = Range("P" & LRow).Value


Sheets("Wing LCPT").Select

'Range("A10").Value = LProject
Range("F7").Value = LIssue
Range("F9").Value = LResponsible
Range("I9").Value = LBORIS
Range("K9").Value = LDaysonReport
Range("I10").Value = LBackupFocal
Range("K10").Value = DALPFocal
Range("F12").Value = LProblem
Range("F16").Value = LRootCause
Range("F20").Value = LEngagement
Range("E24").Value = LProgress
Range("E31").Value = LNextStep
Range("E38").Value = LHelpNeeded
Range("E43").Value = LImpact
Range("E48").Value = LReWork
Range("F10").Value = LReportingFocal


'Encountered a blank project number (assuming end of list on Sheet1)
ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
MsgBox ("No match was found for combo box selection.")
Exit Sub
End If

LRow = LRow + 1
Loop

'Reposition back on Wing LCPT
Sheets("Wing LCPT").Select
Range("J1").Select

End Sub


Peter
 
Upvote 0
Code: 
Sub PopulateWing()

    Dim LProject As Integer
    Dim LIssue As String
    Dim LResponsible As String
    Dim LBORIS As String
    Dim LDaysonReport As String
    Dim LBackupFocal As String
    Dim LDALPFocal As String
    Dim LProblem As String
    Dim LRootCause As String
    Dim LEngagement As String
    Dim LProgress As String
    Dim LNextStep As String
    Dim LHelpNeeded As String
    Dim LImpact  As String
    Dim LReWork As String
    Dim LReportingFocal As String

        
    Dim LRow As Long
    Dim LFound As Boolean
    
    'Retrieve project number number
    LProject = Range("E3").Value
    
    'Move to Sheet
    Sheets("WING LCPT Database").Select
    
    LFound = False
    
    LRow = 2
    
    Do While LFound = False
        'Found matching project, now update address and phone number information on Sheet2
        If Range("A" & LRow).Value = LProject Then
            LFound = True
            LIssue = Range("B" & LRow).Value
            LResponsible = Range("C" & LRow).Value
            LBORIS = Range("D" & LRow).Value
            LDaysonReport = Range("E" & LRow).Value
            LBackupFocal = Range("F" & LRow).Value
            DALPFocal = Range("G" & LRow).Value
            LProblem = Range("H" & LRow).Value
            LRootCause = Range("I" & LRow).Value
            LEngagement = Range("J" & LRow).Value
            LProgress = Range("K" & LRow).Value
            LNextStep = Range("L" & LRow).Value
            LHelpNeeded = Range("M" & LRow).Value
            LImpact = Range("N" & LRow).Value
            LReWork = Range("O" & LRow).Value
            LReportingFocal = Range("P" & LRow).Value

            
            Sheets("Wing LCPT").Select
            
            'Range("A10").Value = LProject
            Range("F7").Value = LIssue
            Range("F7").Font.Color = -4165632
            Range("F9").Value = LResponsible
            Range("F9").Font.Color = -4165632
            Range("I9").Value = LBORIS
            Range("I9").Font.Color = -4165632
            Range("K9").Value = LDaysonReport
            Range("K9").Font.Color = -4165632
            Range("I10").Value = LBackupFocal
            Range("I10").Font.Color = -4165632
            Range("K10").Value = DALPFocal
            Range("K10").Font.Color = -4165632
            Range("F12").Value = LProblem
            Range("F12").Font.Color = -4165632
            Range("F16").Value = LRootCause
            Range("F16").Font.Color = -4165632
            Range("F20").Value = LEngagement
            Range("F20").Font.Color = -4165632
            Range("E24").Value = LProgress
            Range("E24").Font.Color = -4165632
            Range("E31").Value = LNextStep
            Range("E31").Font.Color = -4165632
            Range("E38").Value = LHelpNeeded
            Range("E38").Font.Color = -4165632
            Range("E43").Value = LImpact
            Range("E43").Font.Color = -4165632
            Range("E48").Value = LReWork
            Range("E48").Font.Color = -4165632
            Range("F10").Value = LReportingFocal
            Range("F10").Font.Color = -4165632
            
            
        'Encountered a blank project number (assuming end of list on Sheet1)
        ElseIf IsEmpty(Range("A" & LRow).Value) = True Then
            MsgBox ("No match was found for combo box selection.")
            Exit Sub
        End If
        
        LRow = LRow + 1
    Loop
    
        'Reposition back on Wing LCPT
    Sheets("Wing LCPT").Select
    Range("J1").Select
    
End Sub
 
Upvote 0
Hi Jen,

Example for cell E24 on the WING LCPT Sheet

kjlsjfkjlsjadfaskf;k sd;kf;ska f;ksf ; ks;kf; a;kasf; as; lsdflslkfj flsaf aslfas
fklasf ljlksafjlkj asdfkas;fk;askd;fk;kas;fk;lak sf a;kf;askfas
skf;kas;kdf;kas;dfk;k asd;fk;ask;fk
;lskf;lk;laskd;f ;askf kas;fa
f;lkasl;kdf;k;askf;kas;kf;kaskdf;as;dflasdkf
lkasdfljaslkdflkasjdlfkjakl'sdfjkjalsdkfjlkasldfasdjf

I would input this information in cell E24, then hit update changes button. This will save the data into my sheet "WING LCPT Database".

I would add another issue and save it too...I then go to my pull down selection box and pull the first issue I enter (the example). All the txt when retreive from the WING LCPT Database are not turn to black font. which is the default font for that cell. I would like it to pull the same data and retain all the orginal format and font color of the text. Is this possible?

Peter
 
Upvote 0
I think I see what you are saying.

The first step is to retrieve information from your database sheet, you modify that information, manually color your changes blue and then you want to publish your changes to the database sheet with the same font color formats.
When you pull back the information again, you want the format to carry over from the database sheet.

Unfortunately, I believe this would be a major rewrite of your code. Your current code only captures the values, not the formatting, into variables. I don't believe it is possible to store values and formatting in a variable. I think you will need to copy/paste special all instead.
 
Upvote 0
You must log in or register to reply here.

Similar threads

itsrich
  • Solved
Cell mismatch - not sure why
2
Replies
11
Views
153
itsrich
itsrich
O
  • Question Question
Partial Match Text in Cell and Have It Return Text From a Different Cell
Replies
6
Views
312
Peter_SSs
Peter_SSs
D
  • Solved
Populate cells based on certain fields data input
Replies
7
Views
243
myall_blues
myall_blues
N
  • Question Question
VBA to add title from formula to a save as name
Replies
0
Views
138
NKUNZI
N
R
  • Solved
Dynamic Dropdown list of sheet names
Replies
3
Views
511
alansidman
A

Forum statistics

Threads
1,224,590
Messages
6,179,750
Members
452,940
Latest member
rootytrip

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